                   V. A.  C R O S S  R E F E R E N C E R  7.3
                       [2008 VA Standards & Conventions]
                  UCI: VISTA CPU: ROU    Jun 17, 2016@09:20:58

The BUILD file Data Dictionaries are being processed.

The option and function files are being processed.


Routines are being processed.
Routines: 8  Faux Routines: 1

YSCL122P  YSCLDIS   YSCLSERV  YSCLSRV1  YSCLTST2  YSCLTST3  YSCLTST5  YSCLTST6  

          Data Dictionaries
|opt           

--- CROSS REFERENCING ---

   Press return to continue:

Compiled list of Errors and Warnings              Jun 17, 2016@09:20:58 page 1
No errors or warnings to report


--- Routine Detail   --- with REGULAR ROUTINE LISTING ---
   Press return to continue:

YSCL122P * *  71 Lines,  3621 Bytes, Checksum: B14788856
                                                  Jun 17, 2016@09:20:58 page 2
              641 bytes in comments
YSCL122P ; ALB/RTW - NCC POST INSTALL;05/10/2016
         ;;5.01;MENTAL HEALTH;**122**;Dec 30, 1994;Build 18
         ;THIS ROUTINE IS DESIGNED TO GO THROUGH THE CLOZAPINE PATIENTS IN FILE 
          PS(55 PHARMACY PATIEN FILE
         ;discover active clozapine patients registered longer than 57 days ago 
          that do not have a recent clozapine 
         ;prescription or order, set them to discontinued and send a report to t
          he NCC.
         ;the NCC software will maintain the file in real time from this point o
          n.
INIT     ;
         ;INITIALIZE ^XTMP("YSCLDEM" and ^XTMP("YSCLTRN"
         S ^XTMP("YSCLDEM",0)=DT+365_"^"_DT,$P(^XTMP("YSCLDEM",0),"^",3)="CLOZAP
          INE DAILY ROLLUP DATA",$P(^XTMP("YSCLDEM",0),"^",4)=DT-1_".000001"
         S ^XTMP("YSCLTRN",0)=DT+365_"^"_DT,$P(^XTMP("YSCLTRN",0),"^",3)="CLOZAP
          INE DAILY ROLLUP DATA",$P(^XTMP("YSCLTRN",0),"^",4)=DT-1_".000001"
         D START
         Q
         ;
START    ;
         K ^XTMP("YSCLDIS"),^XTMP("YSCLDATA")
         S YSCLD4="The clozapine patient status has changed to 'Discontinued' du
          ring the post "
         S YSCLD44="installation of patch YS*7*122. Their registration date is m
          ore than 56 days"
         S YSCLD444="ago and there is no a recent filled the prescription/order 
          present. "
         S DFN=0 F  S DFN=$O(^PS(55,"ASAND",DFN)) Q:'DFN  D
         . N YSCLDATA,YSCLOPT
         . S YSCLDATA=$G(^PS(55,DFN,"SAND"))
         . Q:$G(YSCLDATA)=""
         . Q:$P(YSCLDATA,"^",2)="D"  ;Not checking those already discontinued
         . S YSCLREGD=$P(YSCLDATA,"^",6)
         . S X1=DT,X2=YSCLREGD D ^%DTC S YSCLREGA=X
         . Q:YSCLREGA<57  ;Not checking those registered 56 days or less
         . S ^XTMP("YSCLDATA",DT,DFN)=YSCLDATA
         . D OPT I YSCLCNT=1,YSCLOPT="" S YSCLFLAG=2
         . D:YSCLFLAG'=1 INP
         . I YSCLFLAG=2 S YSCLDIS1=1 D DC,DMG^YSCLTST5
         D:$D(^XTMP("YSCLDIS")) TR
         K DA,DFN,X,X1,X2,YSCLCNT,YSCLDIS1,YSCLFLAG,YSCLFLDA,YSCLFLDT,YSCLREGA,Y
          SCLREGD,YSCLPSDA,YSCLREGDA,YSCLREGN,YSCLSPDA
         K YSCLLN,YSCLDIS2,XMTEXT,XMSUB,XMDUZ,YSCLD4,YSCLD44,YSCLD444
         Q
OPT      ; first loop YSCLOPT="A"),-1) causes the loop in reverse order from whe
          re "P","A" is in the global upward from the last prescription
         N YSCLRX,YSCLRX0,YSCLDRG,YSCLPSDT
         S YSCLOPT="A",(YSCLFLAG,YSCLCNT,YSCLPSDT)=0 F  S YSCLOPT=$O(^PS(55,DFN,
          "P",YSCLOPT),-1) S YSCLCNT=YSCLCNT+1 Q:'YSCLOPT  Q:YSCLFLAG>0  D
         . S YSCLRX=$G(^PS(55,DFN,"P",YSCLOPT,0)),YSCLRX0=$G(^PSRX(YSCLRX,0))
         . Q:'+$G(YSCLRX0)
         . S YSCLDRG=$P(YSCLRX0,"^",6)
         . S YSCLPSDT=$P(^PSRX(YSCLRX,2),"^",6)
         . S X1=DT,X2=YSCLPSDT D ^%DTC S YSCLPSDA=X
         . I YSCLPSDA>56,'$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=2,YSCLDIS2=4 Q
         Q
INP      ;
         N YSCLIPT,YSCLUD,YSCLRX0,YSCLDRG,YSCLSPDT
         S:YSCLFLAG'=2 YSCLFLAG=0
         S YSCLIPT="A" F  S YSCLIPT=$O(^PS(55,DFN,5,YSCLIPT),-1) Q:'YSCLIPT!(YSC
          LFLAG>0)  D
         . S YSCLDRG=$P(^PS(55,DFN,5,YSCLIPT,1,1,0),"^",1)
         . Q:'$G(YSCLDRG)
         . Q:'$D(^PSDRUG("ACLOZ",YSCLDRG))
         . S YSCLSPDT=$P($P(^PS(55,DFN,5,YSCLIPT,2),"^",4),".",1)
         . S X1=DT,X2=YSCLSPDT D ^%DTC S YSCLSPDA=X
         . I YSCLSPDT'="",YSCLSPDA>56,'$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=2
          ,YSCLDIS2=4
         . I YSCLSPDT'="",YSCLSPDA>56,$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=1 
          Q
         Q
DC       ;
         N DIE,DR
         S DIE="^PS(55,",DA=DFN,DR="54///"_"D"_";56///1" D ^DIE
         Q
TR       ;
         S XMSUB=$P($$SITE^VASITE,"^",2)_" Discontinued Status by YS*5.01*122 po
          st"
         S XMDUZ="CLOZAPINE MONITOR"
         S ^TMP("YSCL",$J,1,0)="Clozapine Discontinued Patient(s) Data was trans
          mitted, at the time of patch YS*5.01*122 installation "_YSCLLN_" recor
          ds were sent.",XMTEXT="^TMP(""YSCL"",$J,"
         D TR^YSCLDIS
         Q
CHANGE   ; FOR TESTING I SET ALL PATIENTS TO ACTIVE AND NOT TRANSMITTED
         K ^XTMP("YSCLDISPOST"),^XTMP("YSCLDATA")
         S DFN=0 F  S DFN=$O(^PS(55,"ASAND",DFN)) Q:'DFN  D
         . S DIE="^PS(55,",DA=DFN,DR="54///"_"A"_";56///0" D ^DIE
         Q

*****   INDEX OF YSCL122P   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   DA           START+18!,DC+2*,CHANGE+3*
   DFN          START+5*,START+7,START+13,START+18!,OPT+2,OPT+3,INP+3,INP+4
                INP+7,DC+2,CHANGE+2*,CHANGE+3
   DIE          DC+1~,DC+2*,CHANGE+3*
   DR           DC+1~,DC+2*,CHANGE+3*
   DT           INIT+2,INIT+3,START+11,START+13,OPT+7,INP+8
   X            START+11,START+18!,OPT+7,INP+8
   X1           START+11*,START+18!,OPT+7*,INP+8*
   X2           START+11*,START+18!,OPT+7*,INP+8*
   XMDUZ        START+19!,TR+2*
   XMSUB        START+19!,TR+1*
   XMTEXT       START+19!,TR+3*
   YSCLCNT      START+14,START+18!,OPT+2*
   YSCLD4       START+2*,START+19!
   YSCLD44      START+3*,START+19!
   YSCLD444     START+4*,START+19!
   YSCLDATA     START+6~,START+7*,START+8,START+9,START+10,START+13
   YSCLDIS1     START+16*,START+18!
   YSCLDIS2     START+19!,OPT+8*,INP+9*
   YSCLDRG      OPT+1~,OPT+5*,OPT+8,INP+1~,INP+4*,INP+5,INP+6,INP+9,INP+10
   YSCLFLAG     START+14*,START+15,START+16,START+18!,OPT+2*,OPT+8*,INP+2*
                INP+3,INP+9*,INP+10*
   YSCLFLDA     START+18!
   YSCLFLDT     START+18!
   YSCLIPT      INP+1~,INP+3*,INP+4,INP+7
   YSCLLN       START+19!,TR+3
   YSCLOPT      START+6~,START+14,OPT+2*,OPT+3
   YSCLPSDA     START+18!,OPT+7*,OPT+8
   YSCLPSDT     OPT+1~,OPT+2*,OPT+6*,OPT+7
   YSCLREGA     START+11*,START+12,START+18!
   YSCLREGD     START+10*,START+11,START+18!
   YSCLREGDA    START+18!
   YSCLREGN     START+18!
   YSCLRX       OPT+1~,OPT+3*,OPT+6
   YSCLRX0      OPT+1~,OPT+3*,OPT+4,OPT+5,INP+1~
   YSCLSPDA     START+18!,INP+8*,INP+9,INP+10
   YSCLSPDT     INP+1~,INP+7*,INP+8,INP+9,INP+10
   YSCLUD       INP+1~

Global Variables  ( * Changed  ! Killed)
   ^PS(55              START+5,START+7,OPT+2,OPT+3,INP+3,INP+4,INP+7,CHANGE+2
   ^PSDRUG("ACLOZ"     OPT+8,INP+6,INP+9,INP+10
   ^PSRX(              OPT+3,OPT+6
   ^TMP("YSCL"         TR+3*
   ^XTMP("YSCLDATA"    START+1!,START+13*,CHANGE+1!
   ^XTMP("YSCLDEM"     INIT+2*
   ^XTMP("YSCLDIS"     START+1!,START+17
   ^XTMP("YSCLDISPOST" CHANGE+1!
   ^XTMP("YSCLTRN"     INIT+3*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   DC           START+16
   INP          START+15
   OPT          START+14
   START        INIT+4
   TR           START+17

External References
   ^%DTC               START+11,OPT+7,INP+8
   ^DIE                DC+2,CHANGE+3
   $$SITE^VASITE       TR+1
   TR^YSCLDIS          TR+4
   DMG^YSCLTST5        START+16

*****   END   *****

   Press return to continue:

YSCLDIS  * *  177 Lines,  9214 Bytes, Checksum: B63188463
                                                  Jun 17, 2016@09:20:58 page 3
              2355 bytes in comments
YSCLDIS  ;HINOI/RTW-DISCONTINUE CLOZAPINE PATIENT STATUS ;07 April 16
         ;;5.01;MENTAL HEALTH;**122**;Dec 30, 1994;Build 18
         ; Reference to ^DPT supported by IA #10035
         ; Reference to ^PS(55 supported by IA #787
         ;
         ;This routine will loop through ^PS(55,DFN,"ASAND" and check the last p
          rescription
         ; enddate and/or the the Inpatient Order stop date. If the patient has 
          not had an
         ; active prescription or Inpatent Clozapine Order in the last 56 days, 
          the CLOZAPINE
         ; STATUS will be marked as discontinued.
         ; DFN is the patient DFN found in ^DPT( file #2 the patient field
         ; YSCLDATA hold the clozapine patient data from the "SAND"xref
         ; YSCLFLAG changes from 0 to 1 if criteria to avoid discontinueing the 
          patient is met
         ; also if the YSCLFLAG is already changed to 1 after OPT there is not n
          eed to check inpatient
         ; YSCLFLAG changes from 0 to 2 if discontinuation is required
         ; YSCLPSDT is the PRESCRIPTION STOP or END DaTe
         ; YSCLRX is the prescription IEN in the ^PSRX precription file
         ; YSCLDRG is the drug number used in this to determine if the drug numb
          er is part of the clozapine xref
         ;If a new patient is registered with the NCCC and 28 days have passed s
          ince the registration and
         ; there has been NO Clozapine preciptions or Inpatient orders, the CLOZ
          APINE STATUS will be
         ; marked as discontinued.
         ;YSCLREGD is the registration date recorded in PS(55,DFN,"SAND" peice 6
         ;YSCLDIS1 determines subject of message these from the POST 122 install
         ;YSCLDIS2 determines the message used in the xmtext for this patient. i
          s it 28 day 56 day or temp cloz discontinue
         Q
START    ;
         K ^XTMP("YSCLDIS"),^XTMP("YSCLDATA")
         S DFN=0 F  S DFN=$O(^PS(55,"ASAND",DFN)),YSCLFLAG=0 Q:'DFN  D
         . N YSCLDATA,YSCLOPT
         . S YSCLDATA=$G(^PS(55,DFN,"SAND"))
         . Q:$G(YSCLDATA)=""
         . Q:$P(YSCLDATA,"^",2)="D"  ;Not checking those already discontinued
         . S YSCLREGN=$P(YSCLDATA,"^",1)
         . S YSCLREGD=$P(YSCLDATA,"^",6)
         . S X1=DT,X2=YSCLREGD D ^%DTC S YSCLREGA=X
         . I YSCLREGN["Z",YSCLREGA>4 S YSCLFLAG=2,YSCLDIS2=3 D SET ;temps greate
          r than four days since reg
         . ;Q:YSCLREGA<(28)  ;Not checking those registered 27 days or less
         . I YSCLREGN'["Z",YSCLREGA<(28) Q
         . S ^XTMP("YSCLDATA",DT,DFN)=YSCLDATA
         . I '$G(YSCLFLAG) D OPT I YSCLCNT=1,YSCLOPT=0 S YSCLFLAG=2
         . D:YSCLFLAG'=1 INP
         . I YSCLFLAG=2 D YSCLFLAG,DC,DMG^YSCLTST5
         D:$D(^XTMP("YSCLDIS")) TR
         K DA,DFN,X,X1,X2,YSCLCNT,YSCLDIS1,YSCLFLAG,YSCLFLDA,YSCLFLDT,YSCLREGA,Y
          SCLREGD,YSCLPSDA,YSCLREGDA,YSCLSPDA
         K PSOLAST4,YSCLD1,YSCLD11,YSCLD111,YSCLD2,YSCLD22,YSCLD222,YSCLD3,YSCLD
          33,YSCLD333,YSCLDATE,YSCLDIS2,YSCLLN,YSCLREGN
         K XMDUZ,XMSUB,XMTEXT,Y,YSCLD4,YSCLD44,YSCLD444,YSCLDFN,YSCLMESG
         Q
OPT      ; first loop YSCLOPT="A"),-1) causes the loop in reverse order from whe
          re "P","A" is in the global upward from the last prescription
         N YSCLRX,YSCLRX0,YSCLDRG,YSCLPSDT
         S YSCLOPT="A",(YSCLFLAG,YSCLCNT,YSCLPSDT)=0 F  S YSCLOPT=$O(^PS(55,DFN,
          "P",YSCLOPT),-1) S YSCLCNT=YSCLCNT+1 D:'YSCLOPT YSCLFLAG Q:'YSCLOPT  Q
          :YSCLFLAG>0  D
         . S YSCLRX=$G(^PS(55,DFN,"P",YSCLOPT,0)),YSCLRX0=$G(^PSRX(YSCLRX,0))
         . Q:'+$G(YSCLRX0)
         . S YSCLPSDT=$P(^PSRX(YSCLRX,2),"^",6)
         . S X1=DT,X2=YSCLPSDT D ^%DTC S YSCLPSDA=X
         . Q:YSCLPSDA>56
         . S YSCLFLDT=$P(^PSRX(YSCLRX,2),"^",2)
         . S X1=DT,X2=YSCLFLDT D ^%DTC S YSCLFLDA=X
         . S YSCLDRG=$P(YSCLRX0,"^",6)
         . ;Below is for new registrations or reregistrations must have a fill w
          ithin 28 days or they are discontinued
         . I YSCLREGA<57,YSCLREGA>27,YSCLFLDT>(YSCLREGD) D
         . . I $D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=1 Q
         . . I '$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLDIS2=1,YSCLFLAG=2
         . . ;Below is for  exiting registrations must have a fill less than 56 
          days apart or they are discontinued
         . D:YSCLPSDA<57  ;stop date 56 days or less in the past check for cloza
          pine
         . . I $D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=1 Q
         . . I '$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLDIS2=2,YSCLFLAG=2 Q
         Q
INP      ;
         ;YSCLIPT incremented inpatient orders, example PS(55,DFN,5,1,1,0)="8440
          9"
         ;YSCLUD
         ;YSCLRXO
         ;YSCLDRG is the drug number
         ;YSCLSPDT is the date the last clozapine order stopped
         N YSCLIPT,YSCLUD,YSCLRX0,YSCLDRG,YSCLSPDT
         S:YSCLFLAG'=2 YSCLFLAG=0
         S YSCLIPT="A" F  S YSCLIPT=$O(^PS(55,DFN,5,YSCLIPT),-1) Q:'YSCLIPT!(YSC
          LFLAG>0)  D
         . Q:'$D(^PS(55,DFN,5,YSCLIPT,1,1,0))
         . S YSCLDRG=$P(^PS(55,DFN,5,YSCLIPT,1,1,0),"^",1)
         . Q:'$G(YSCLDRG)
         . Q:'$D(^PSDRUG("ACLOZ",YSCLDRG))
         . S YSCLSPDT=$P($P(^PS(55,DFN,5,YSCLIPT,2),"^",4),".",1)
         . S X1=DT,X2=YSCLSPDT D ^%DTC S YSCLSPDA=X
         . I YSCLSPDT'="",YSCLSPDA<57,'$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLDIS2=2
          ,YSCLFLAG=2
         . I YSCLREGA>27,YSCLREGA<57,'$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLDIS2=1,
          YSCLFLAG=2
         . I YSCLREGA>27,YSCLREGA<57,$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=1,Y
          SCLDIS2=1 Q
         . I YSCLSPDT'="",YSCLSPDA<57,$D(^PSDRUG("ACLOZ",YSCLDRG)) S YSCLFLAG=1,
          YSCLDIS2=2 Q
         Q
DC       ;
         N DIE,DR
         S DIE="^PS(55,",DA=DFN,DR="54///"_"D"_";56///1" D ^DIE
         Q
TR       ;
         K ^TMP("YSCL",$J)
         X ^%ZOSF("UCI") I Y=^%ZOSF("PROD") D
         . D YSCLDRSN
         . K XMY S XMY("G.CLOZAPINE ROLL-UP")="",XMY=("G.CLOZAPINE ROLL-UP@FORUM
          .DNS   ")
         . D YSXMTEXT
         . S XMDUZ="CLOZAPINE MONITOR",^TMP("YSCL",$J,1,0)="Clozapine Discontinu
          ed Patient(s) Data was transmitted, "_YSCLLN_" records were sent."
         . I YSCLDIS2'>3 S XMSUB=$P($$SITE^VASITE,"^",2)_" Discontinued Status",
          ^TMP("YSCL",$J,2,0)=" "
         . S XMTEXT="^TMP(""YSCL"",$J," D ^XMD S $P(^YSCL(603.03,1,0),"^",6)=$$N
          OW^XLFDT
         I Y'=^%ZOSF("PROD") D
         . D YSCLDRSN
         . K XMY S XMY("G.CLOZAPINE ROLL-UP")="",XMY=("G.CLOZAPINE ROLL-UP@FORUM
          .DNS   ")
         . D YSXMTEXT
         . I YSCLDIS2'>3 S XMSUB=$P($$SITE^VASITE,"^",2)_" Discontinued Status",
          ^TMP("YSCL",$J,2,0)=" "
         . S XMDUZ="CLOZAPINE MONITOR",^TMP("YSCL",$J,1,0)="Clozapine Discontinu
          ed Patient(s) Data was transmitted, "_YSCLLN_" records were sent."
         . S XMTEXT="^TMP(""YSCL"",$J," D ^XMD S $P(^YSCL(603.03,1,0),"^",6)=$$N
          OW^XLFDT
         Q
SET      ;XTMP BUILD USED FOR TESTING
         S ^XTMP("YSCLDIS",DT,DFN,0)=YSCLDIS2
         Q
YSCLFLAG ;used when there are no prescriptions or orders
         I YSCLREGA>28,YSCLREGA<57 S (YSCLFLAG,YSCLDIS1,YSCLDIS2)=2 D SET Q
         I YSCLREGA=28 S (YSCLFLAG,YSCLDIS1)=2,YSCLDIS2=1 D SET Q
         Q
YSXMTEXT ;CALLED BY YSCLTST3 /RTW Start: Added to build message of discontinued 
          clozapine patients data for NCC
         S (YSCLLN,YSCLDATE)=0,YSCLCNT=2 F  S YSCLDATE=$O(^XTMP("YSCLDIS",YSCLDA
          TE)) Q:'YSCLDATE  D
         . S YSCLDFN=0 F  S YSCLDFN=$O(^XTMP("YSCLDIS",YSCLDATE,YSCLDFN)) Q:'YSC
          LDFN  D
         . . S YSCLDIS2=$P(^XTMP("YSCLDIS",YSCLDATE,YSCLDFN,0),"^",1)
         . . S PSOLAST4=$E($P($G(^DPT(YSCLDFN,0)),"^",9),6,9)
         . . S YSCLMESG=$$GET1^DIQ(2,YSCLDFN,.01)_" ("_PSOLAST4_")"
         . . I YSCLDIS2=1 D  ;28 day patients
         . . . S YSCLCNT=YSCLCNT+1,YSCLLN=YSCLLN+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLMESG ;message from YSCLDRSN
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD1
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD11
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD111
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)="" ;blank line
         . . I YSCLDIS2=2 D  ;56 day patients
         . . . S YSCLCNT=YSCLCNT+1,YSCLLN=YSCLLN+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLMESG ;message from YSCLDRSN
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD2
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD22
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD222
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)="" ;blank line
         . . I YSCLDIS2=3 D  ; temporary clozapine patients
         . . . S YSCLCNT=YSCLCNT+1,YSCLLN=YSCLLN+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLMESG ;message from YSCLDRSN
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD3
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD33
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD333
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)="" ;blank line
         . . I YSCLDIS2=4 D  ; temporary clozapine patients
         . . . S YSCLCNT=YSCLCNT+1,YSCLLN=YSCLLN+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLMESG ;message from YSCLDRSN
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD4
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD44
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)=YSCLD444
         . . . S YSCLCNT=YSCLCNT+1
         . . . S ^TMP("YSCL",$J,YSCLCNT,0)="" ;blank line
         Q
YSCLDRSN ;CALLED BY YSCLTST3  discontinued reasons
         S YSCLD1="The patient status has changed to 'Discontinued' because the 
          new clozapine"
         S YSCLD11="patient has not filled the prescription/order within 28 days
           of being marked "
         S YSCLD111="'Active'. "
         S YSCLD2="The patient status has changed to 'Discontinued' because the 
          active clozapine"
         S YSCLD22="patient has not filled the prescription/order within 56 days
           of being "
         S YSCLD222="prescribed/ordered."
         S YSCLD3="The patient status has changed to 'Discontinued' because the 
          temporary local "
         S YSCLD33="authorization number assigned has expired and NCCC has not i
          ssued a new "
         S YSCLD333="authorization number. "
         Q 
         ;/RTW End: Added to build message of discontinued clozapine patients da
          ta for NCC

*****   INDEX OF YSCLDIS   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   DA           START+18!,DC+2*
   DFN          START+2*,START+4,START+13,START+18!,OPT+2,OPT+3,INP+8,INP+9
                INP+10,INP+13,DC+2,SET+1
   DIE          DC+1~,DC+2*
   DR           DC+1~,DC+2*
   DT           START+9,START+13,OPT+6,OPT+9,INP+14,SET+1
   PSOLAST4     START+19!,YSXMTEXT+4*,YSXMTEXT+5
   X            START+9,START+18!,OPT+6,OPT+9,INP+14
   X1           START+9*,START+18!,OPT+6*,OPT+9*,INP+14*
   X2           START+9*,START+18!,OPT+6*,OPT+9*,INP+14*
   XMDUZ        START+20!,TR+6*,TR+14*
   XMSUB        START+20!,TR+7*,TR+13*
   XMTEXT       START+20!,TR+8*,TR+15*
   XMY          TR+4!*,TR+11!*
   XMY("G.CLOZAPINE ROLL-UP" 
                TR+4*,TR+11*
   Y            START+20!,TR+2,TR+9
   YSCLCNT      START+14,START+18!,OPT+2*,YSXMTEXT+1*,YSXMTEXT+7*,YSXMTEXT+8
                YSXMTEXT+9*,YSXMTEXT+10,YSXMTEXT+11*,YSXMTEXT+12,YSXMTEXT+13*
                YSXMTEXT+14,YSXMTEXT+15*,YSXMTEXT+16,YSXMTEXT+18*,YSXMTEXT+19
                YSXMTEXT+20*,YSXMTEXT+21,YSXMTEXT+22*,YSXMTEXT+23
                YSXMTEXT+24*,YSXMTEXT+25,YSXMTEXT+26*,YSXMTEXT+27,YSXMTEXT+29*
                YSXMTEXT+30,YSXMTEXT+31*,YSXMTEXT+32,YSXMTEXT+33*,YSXMTEXT+34
                YSXMTEXT+35*,YSXMTEXT+36,YSXMTEXT+37*,YSXMTEXT+38,YSXMTEXT+40*
                YSXMTEXT+41,YSXMTEXT+42*,YSXMTEXT+43,YSXMTEXT+44*
                YSXMTEXT+45,YSXMTEXT+46*,YSXMTEXT+47,YSXMTEXT+48*,YSXMTEXT+49
   YSCLD1       START+19!,YSXMTEXT+10,YSCLDRSN+1*
   YSCLD11      START+19!,YSXMTEXT+12,YSCLDRSN+2*
   YSCLD111     START+19!,YSXMTEXT+14,YSCLDRSN+3*
   YSCLD2       START+19!,YSXMTEXT+21,YSCLDRSN+4*
   YSCLD22      START+19!,YSXMTEXT+23,YSCLDRSN+5*
   YSCLD222     START+19!,YSXMTEXT+25,YSCLDRSN+6*
   YSCLD3       START+19!,YSXMTEXT+32,YSCLDRSN+7*
   YSCLD33      START+19!,YSXMTEXT+34,YSCLDRSN+8*
   YSCLD333     START+19!,YSXMTEXT+36,YSCLDRSN+9*
   YSCLD4       START+20!,YSXMTEXT+43
   YSCLD44      START+20!,YSXMTEXT+45
   YSCLD444     START+20!,YSXMTEXT+47
   YSCLDATA     START+3~,START+4*,START+5,START+6,START+7,START+8,START+13
   YSCLDATE     START+19!,YSXMTEXT+1*,YSXMTEXT+2,YSXMTEXT+3
   YSCLDFN      START+20!,YSXMTEXT+2*,YSXMTEXT+3,YSXMTEXT+4,YSXMTEXT+5
   YSCLDIS1     START+18!,YSCLFLAG+1*,YSCLFLAG+2*
   YSCLDIS2     START+10*,START+19!,OPT+14*,OPT+18*,INP+15*,INP+16*,INP+17*
                INP+18*,TR+7,TR+13,SET+1,YSCLFLAG+1*,YSCLFLAG+2*,YSXMTEXT+3*
                YSXMTEXT+6,YSXMTEXT+17,YSXMTEXT+28,YSXMTEXT+39
   YSCLDRG      OPT+1~,OPT+10*,OPT+13,OPT+14,OPT+17,OPT+18,INP+6~,INP+10*
                INP+11,INP+12,INP+15,INP+16,INP+17,INP+18
   YSCLFLAG     START+2*,START+10*,START+14*,START+15,START+16,START+18!,OPT+2*
                OPT+13*,OPT+14*,OPT+17*,OPT+18*,INP+7*,INP+8,INP+15*,INP+16*
                INP+17*,INP+18*,YSCLFLAG+1*,YSCLFLAG+2*
   YSCLFLDA     START+18!,OPT+9*
   YSCLFLDT     START+18!,OPT+8*,OPT+9,OPT+12
   YSCLIPT      INP+6~,INP+8*,INP+9,INP+10,INP+13
   YSCLLN       START+19!,TR+6,TR+14,YSXMTEXT+1*,YSXMTEXT+7*,YSXMTEXT+18*
                YSXMTEXT+29*,YSXMTEXT+40*
   YSCLMESG     START+20!,YSXMTEXT+5*,YSXMTEXT+8,YSXMTEXT+19,YSXMTEXT+30
                YSXMTEXT+41
   YSCLOPT      START+3~,START+14,OPT+2*,OPT+3
   YSCLPSDA     START+18!,OPT+6*,OPT+7,OPT+16
   YSCLPSDT     OPT+1~,OPT+2*,OPT+5*,OPT+6
   YSCLREGA     START+9*,START+10,START+12,START+18!,OPT+12,INP+16,INP+17
                YSCLFLAG+1,YSCLFLAG+2
   YSCLREGD     START+8*,START+9,START+18!,OPT+12
   YSCLREGDA    START+18!
   YSCLREGN     START+7*,START+10,START+12,START+19!
   YSCLRX       OPT+1~,OPT+3*,OPT+5,OPT+8
   YSCLRX0      OPT+1~,OPT+3*,OPT+4,OPT+10,INP+6~
   YSCLSPDA     START+18!,INP+14*,INP+15,INP+18
   YSCLSPDT     INP+6~,INP+13*,INP+14,INP+15,INP+18
   YSCLUD       INP+6~

Global Variables  ( * Changed  ! Killed)
   ^%ZOSF("PROD"       TR+2,TR+9
   ^%ZOSF("UCI"        TR+2
   ^DPT(               YSXMTEXT+4
   ^PS(55              START+2,START+4,OPT+2,OPT+3,INP+8,INP+9,INP+10,INP+13
   ^PSDRUG("ACLOZ"     OPT+13,OPT+14,OPT+17,OPT+18,INP+12,INP+15,INP+16,INP+17
                       INP+18
   ^PSRX(              OPT+3,OPT+5,OPT+8
   ^TMP("YSCL"         TR+1!,TR+6*,TR+7*,TR+13*,TR+14*,YSXMTEXT+8*,YSXMTEXT+10*
                       YSXMTEXT+12*,YSXMTEXT+14*,YSXMTEXT+16*,YSXMTEXT+19*
                       YSXMTEXT+21*,YSXMTEXT+23*,YSXMTEXT+25*,YSXMTEXT+27*
                       YSXMTEXT+30*,YSXMTEXT+32*,YSXMTEXT+34*,YSXMTEXT+36*
                       YSXMTEXT+38*,YSXMTEXT+41*
                       YSXMTEXT+43*,YSXMTEXT+45*,YSXMTEXT+47*,YSXMTEXT+49*
   ^XTMP("YSCLDATA"    START+1!,START+13*
   ^XTMP("YSCLDIS"     START+1!,START+17,SET+1*,YSXMTEXT+1,YSXMTEXT+2
                       YSXMTEXT+3
   ^YSCL(603.03        TR+8*,TR+15*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   DC           START+16
   INP          START+15
   OPT          START+14
   SET          START+10,YSCLFLAG+1,YSCLFLAG+2
   TR           START+17
   YSCLDRSN     TR+3,TR+10
   YSCLFLAG     START+16,OPT+2
   YSXMTEXT     TR+5,TR+12

External References
   ^%DTC               START+9,OPT+6,OPT+9,INP+14
   ^DIE                DC+2
   $$GET1^DIQ          YSXMTEXT+5
   $$SITE^VASITE       TR+7,TR+13
   $$NOW^XLFDT         TR+8,TR+15
   ^XMD                TR+8,TR+15
   DMG^YSCLTST5        START+16

*****   END   *****

   Press return to continue:

YSCLSERV * *  162 Lines,  10747 Bytes, Checksum: B82789942
                                                  Jun 17, 2016@09:20:58 page 4
              2424 bytes in comments
YSCLSERV ;DALOI/RLM-Clozapine data server ;24 APR 1990
         ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122**;Dec 30, 1994;Bu
          ild 7
         ; Reference to ^%ZOSF supported by IA #10096
         ; Reference to ^DPT supported by IA #10035
         ; Reference to ^DD("DD" supported by IA #10017
         ; Reference to ^PS(55 supported by IA #787
         ; Reference to ^PSDRUG supported by IA #25
         ; Reference to ^PSRX supported by IA #780
         ; Reference to ^VA(200 supported by IA #10060
         ; Reference to $$SITE^VASITE supported by IA #10112
         ; Reference to $$FMTE^XLFDT() supported by IA #10103
         ; Reference to ^PSDRUG supported by IA #221
         ; Reference to ^XMD supported by IA #10070
START    ;
         K ^TMP($J,"YSCLDATA")
         S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3)
         S YSCLST=$P($$SITE^VASITE,"^",3)
         S YSCLSTN=$P($$SITE^VASITE,"^",2)
         ;Determine station number
         I $G(PSCLOZ) G UNREG
         S X=XQSUB X ^%ZOSF("UPPERCASE") S YSCLSUB=Y
         S ^TMP($J,"YSCLDATA",1)=$S(YSDEBUG:"DEBUG ",1:"")_YSCLSUB_" triggered a
          t "_YSCLST_" by "_XMFROM_" on "_XQDATE
         ;The first line of the message tells who requested the action and when
         D
          . S YSACTION=$S(YSCLSUB["REMOVE"!(YSCLSUB["DELETE"):"data deleted",YSC
          LSUB["REPORT":"report generated",YSCLSUB["REBUILD":"data verified",YSC
          LSUB["UPDATE":"data updated",YSCLSUB["DATESET":"date set",1:"CONT")
          . I YSACTION="CONT" S YSACTION=$S(YSCLSUB["DEMOG RESET":"Demographics 
          Flag Reset",YSCLSUB["DEBUG":"Debug Mode set",YSCLSUB["AUTH":"Authoriza
          tion",YSCLSUB["LOCK":"Lock",1:"Site Lock")
          . S ^TMP($J,"YSCLDATA",2)="No "_$S(YSDEBUG:"DEBUG ",1:"")_YSACTION_" a
          t "_YSCLST
         ;The second line tells when the server is activated and no data can be
         ;gathered from the MailMan message.  This line gets replaced if the
         ;server finds something to do.
         S YSCLLNT=1 I YSCLSUB["REMOVE"!(YSCLSUB["DELETE") G DELETE
         ;If the subject contains the word REMOVE or DELETE delete those entries
           from the list.
         I YSCLSUB["REPORT" G REPORT
         ;If the subject contains "REPORT" send a report of the currently regist
          ered patients to the Clozapine group on Forum
         ;I YSCLSUB["REBUILD" G REBUILD
         I YSCLSUB["RESEND" G RESEND
         I YSCLSUB["UPDATE" G UPDATE
         ;I YSCLSUB["CHECKSUM" G CSUM^YSCLSRV1
         I YSCLSUB["DATESET" G DSET
         I YSCLSUB["DEBUG" G DEBUG
         I YSCLSUB["PATIENT" G ^YSCLSRV3
         I YSCLSUB["LOCKOUT" G LOCK^YSCLSRV3
         I YSCLSUB="DEMOG RESET" G DEMOG^YSCLSRV3
         I YSCLSUB["AUTHORIZE" G AUTH^YSCLSRV3
         I YSCLSUB="OVERRIDE" G OVRRID^YSCLSRV2
         I YSCLSUB="CLAPI" G CLAPI^YSCLSRV2
         I YSCLSUB="CL1API" G CL1API^YSCLSRV2
         I YSCLSUB["DISCON" G DCON^YSCLSRV2
         ;/RBN Begin mods - YS*5.01*122
UNREG    I $G(PSCLOZ) D  Q
         . ;Verify that + of site number matches local site number
         . I XMRG'?1"Z"4.6N1",".U1",".U1","4N S YSCLER=" is in error and was not
           added at " D OUT Q
         . I $P(XMRG,",")'?1"Z"4.6N S YSCLER=" is not a valid Clozapine number "
           D OUT Q
         . I $P(XMRG,",",4)'?4N S YSCLER=" An SSN must be 4 numbers " D OUT Q
         . ;Validate the format of the data in the message and report the error.
         . S DIC="^DPT(",DIC(0)="X",D="SSN",X=SSN I '$D(^DPT("SSN",X)) S YSCLER=
          " SSN does not exist at " D OUT Q
         . ;Do not add data for records where the SSN sent is not in the local d
          atabase
         . I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(X
          MRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=
          " Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q
         . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OU
          T Q
         . ;Add the data and report any errors to the Roll-Up group at Forum.
         . K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";
          2////"_"W" K DO D FILE^DICN
         . S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YS
          CL(603.01,YSCLX,0),"^",2),YSCLER=" assigned to "_$P($G(^DPT(YSCLX,0)),
          "^")_" at " D OUT
         ;/RBN End mods - YS*5.01*122
         F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
         . ;Verify that + of site number matches local site number
         . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at 
          " D OUT Q
         . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number " D O
          UT Q
         . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
         . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCLE
          R=" You must specify Weekly, Biweekly, or Monthly " D OUT Q
         . ;Validate the format of the data in the message and report the error.
         . S DIC="^DPT(",DIC(0)="X",D="SSN",X=$P(XMRG,",",2) I '$D(^DPT("SSN",X)
          ) S YSCLER=" SSN does not exist at " D OUT Q
         . ;Do not add data for records where the SSN sent is not in the local d
          atabase
         . I $D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLX=$O(^YSCL(603.01,"B",$P(X
          MRG,","),"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),"^",2),YSCLER=
          " Clozapine # is in use by "_$P($G(^DPT(YSCLX,0)),"^")_" at " D OUT Q
         . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OU
          T Q
         . ;Add the data and report any errors to the Roll-Up group at Forum.
         . K DD S DIC="^YSCL(603.01,",X=$P(XMRG,","),DIC("DR")="1////"_YSCLPT_";
          2////W" K DO D FILE^DICN
         . S YSCLX=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) S:YSCLX]"" YSCLX=$P(^YS
          CL(603.01,YSCLX,0),"^",2),YSCLER=" assigned to "_$P($G(^DPT(YSCLX,0)),
          "^")_" at " D OUT
EXIT     ;If all went well, report that too.
         S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3)
         S %H=$H D YMD^%DTC S XMDUN="NCCC LOGGER",XMDUZ=".5",XMSUB=$S(YSDEBUG:"D
          EBUG ",YSCLSUB["DEBUG":"DEBUG ",1:"")_YSCLST_" NCCC ENROLLER ("_X_%_")
          ",XMTEXT="^TMP($J,""YSCLDATA"","
         ;/RBN -Begin modifications for PSO*7.0*122
         X ^%ZOSF("UCI") I Y=^%ZOSF("PROD"),YSCLLN D
         . K XMY S XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   ")=""
         . I YSDEBUG!(YSCLSUB["DEBUG") S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.VA
          .GOV")=""
         I Y'=^%ZOSF("PROD"),YSCLLN D
         . K XMY S XMY("G.CLOZAPINE ROLL-UP")=""
         . I YSDEBUG!(YSCLSUB["DEBUG") S XMY("G.CLOZAPINE DEBUG")=""
         ;/RBN - End modifications for YS*5.01*122
         D ^XMD
         ;Mail the errors and successes back to the Roll-Up group at Forum.
         K ^TMP($J,"YSCLDATA")
         K %,%DT,%H,D,DA,DD,DIC,DIE,DIK,RET,X,XMDUN,XMDUZ,XMER,XMFROM
         K XMREC,XMRG,XMSUB,XMTEXT,XMY,XMZ,XQDATE,XQSUB,Y,YSA,YSACTION,YSCLTYPE
         K YSCL28,YSCLA,YSCLAA,YSCLB,YSCLC,YSCLDA,YSCLDA1,YSCLDATA,YSCLDEA1
         K YSCLDFN,YSCLDM,YSCLDOC,YSCLDOM,YSCLDR,YSCLDRA,YSCLDRB,YSCLDTA,YSCLERR
         K YSCLDUZ,YSCLED,YSCLER,YSCLFDA,YSCLFRQ,YSCLLNT,YSCLNM,YSCLOVR,YSCLSITE
         K YSCLPT,YSCLRPT,YSCLSD1,YSCLSDT,YSCLSSN,YSCLST,YSCLSTN,YSCLSUB,YSCLTC
         K YSCLRX,YSCLSAND,YSCLWB,YSCLX,YSCLYN,YSDEBUG,YSI,YSOFF,YSPR,ZTQUEUED,Z
          TSK
         Q
DELETE   ;Allow the NCCC users to delete clozapine registration at the individua
          l sites
         S YSCLLNT=1 F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
          . I XMRG="**++**DELETEALL**++**" D DELALL Q
          . I '$D(^YSCL(603.01,"B",$P(XMRG,","))) S YSCLER=" "_$P(XMRG,",")_" is
           not registered at " D OUT Q
          . S YSCLDFN=$O(^DPT("SSN",$P(XMRG,",",2),"")) I YSCLDFN="" S YSCLER=" 
          "_$P(XMRG,",")_" is not a valid SSN at " D OUT Q
          . I '$D(^YSCL(603.01,"C",YSCLDFN)) S YSCLER=" "_$P(XMRG,",",2)_" is no
          t registered at " D OUT Q
          . S YSCLA=$O(^YSCL(603.01,"B",$P(XMRG,","),"")) I YSCLA="" S YSCLER=" 
          "_$P(XMRG,",")_" is not a valid entry at " D OUT Q
          . K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$P(XMRG,","),YSCLA),^YSCL(603
          .01,"C",YSCLDFN,YSCLA)
          . S YSCLER=" removed at " D OUT
          . ;I $D(^YSCL(603.01,"C",+Y)) K ^YSCL(603.01,YSCLA),^YSCL(603.01,"B",$
          P(XMRG,","),YSCLA),^YSCL(603.01,"C",YSCLDFN,YSCLA) S YSCLER=" removed 
          at " D OUT Q  ;RLM 9-29-99 ADDED QUIT
         G EXIT
DELALL   ;Delete all patients in file 603.01
         S YSCLA=0 F  S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:YSCLA=""  D
          . I YSCLA S YSCLER=$P(^YSCL(603.01,YSCLA,0),"^",1)_", "_$P(^DPT($P(^YS
          CL(603.01,YSCLA,0),"^",2),0),"^",9)_", ("_$P(^YSCL(603.01,YSCLA,0),"^"
          ,3)_") gdeleted at " D OUT
          . K ^YSCL(603.01,YSCLA)
         Q
REPORT   ;send report of current registrations to the Clozapine group on Forum
         D REPORT^YSCLSRV2 G EXIT
OUT      S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=XMRG_YSCLER_YSCLST 
          Q
         ;Build the text for the return message here.
REBUILD  ;
         D REBUILD^YSCLSRV2 G EXIT
UPDATE   ;Update record with Monthly, Weekly or Bi-weekly status
         F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
          . I XMRG'?2U5N1","9N1","1U S YSCLER=" is in error and was not added at
           " D OUT Q
          . I $P(XMRG,",")'?2U5N S YSCLER=" is not a valid Clozapine number form
          at " D OUT Q
          . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
          . I $P(XMRG,",",3)'="B",$P(XMRG,",",3)'="W",$P(XMRG,",",3)'="M" S YSCL
          ER=" You must specify Monthly, Weekly or Biweekly " D OUT Q  ;RLM 06/1
          5/05
          . S YSCLNM=$P(XMRG,","),YSCLSSN=$P(XMRG,",",2),YSCLWB=$P(XMRG,",",3)
          . I '$D(^YSCL(603.01,"B",YSCLNM)) S YSCLER=" does not exist at " D OUT
           Q
          . S YSCLDA=$O(^DPT("SSN",YSCLSSN,0))
          . I YSCLDA="" S YSCLER=" SSN does not exist at " D OUT Q
          . I $O(^YSCL(603.01,"B",YSCLNM,0))="" S YSCLER=" SSN not in Clozapine 
          file " D OUT Q
          . I $O(^DPT("SSN",YSCLSSN,YSCLDA)) S YSCLER=" SSN has more than one ow
          ner " D OUT Q
          . I $O(^YSCL(603.01,"B",YSCLNM,0))'=$O(^YSCL(603.01,"C",YSCLDA,0)) S Y
          SCLER=" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),"^")_") has multiple Cloz
          apine Numbers at " D OUT
          . I $O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0)) D
          . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1
          ,0),"^",3)=YSCLWB
          . . S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),"^")_") updated to "_$S
          (YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Un
          known")_" at " D OUT ;06/15/05
         G EXIT
RESEND   ;Trigger retransmission of Clozapine data
         X XMREC
         K %DT S X=XMRG,%DT="P" D ^%DT I Y=-1 S YSCLER=" is an invalid date, RES
          END not triggered at " D OUT G EXIT
         S YSCLED=Y,(YSCLSDT,X)=Y D H^%DTC I %H#7'=5 S YSCLER=" is not a Tuesday
          , RESEND not triggered at " D OUT G EXIT
         D SERV^YSCLTST2
         S Y=YSCLSDT X ^DD("DD") S YSCLER=" - Resend triggered (local task #"_$G
          (ZTSK)_") by "_XMFROM_" for "_Y_" at " D OUT
         G EXIT
DSET     ;Set the day of the week for the roll-up to run.
         X XMREC Q:XMER<0  S X=$TR(XMRG,"- ","")
         S YSOFF=$S(X="SUNDAY":0,X="MONDAY":1,X="TUESDAY":2,X="WEDNESDAY":3,X="T
          HURSDAY":4,X="FRIDAY":5,X="SATURDAY":6,1:7)
         I YSOFF>6 S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)=X_" isn't
           a valid day of the week." G EXIT
         S $P(^YSCL(603.03,1,0),"^",2)=X
         S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Run day set to "_X
         G EXIT
         Q
DEBUG    ;Turn debug mode on and off.
         I YSCLSUB["DEBUG ON" D
          . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "
          _$S(YSDEBUG:"already",1:"now")_" ON at "_YSCLSTN
          . S $P(^YSCL(603.03,1,0),"^",3)=1
         I YSCLSUB["DEBUG OFF" D
          . S YSCLLNT=$G(YSCLLNT)+1,^TMP($J,"YSCLDATA",YSCLLNT)="Debug Mode is "
          _$S('YSDEBUG:"already",1:"now")_" OFF at "_YSCLSTN
          . S $P(^YSCL(603.03,1,0),"^",3)=0
         G EXIT
ZEOR     ;YSCLSERV

*****   INDEX OF YSCLSERV   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %            EXIT+2,EXIT+14!
   %DT          EXIT+14!,RESEND+2!*
   %H           EXIT+2*,EXIT+14!,RESEND+3
   D            UNREG+6*,UNREG+21*,EXIT+14!
   DA           EXIT+14!
   DD           UNREG+11!,UNREG+26!,EXIT+14!
   DIC          UNREG+6*,UNREG+11*,UNREG+21*,UNREG+26*,EXIT+14!
   DIC("DR"     UNREG+11*,UNREG+26*
   DIC(0        UNREG+6*,UNREG+21*
   DIE          EXIT+14!
   DIK          EXIT+14!
   DO           UNREG+11!,UNREG+26!
>> PSCLOZ       START+6,UNREG
   RET          EXIT+14!
>> SSN          UNREG+6
   X            START+7*,UNREG+6*,UNREG+11*,UNREG+21*,UNREG+26*,EXIT+2,EXIT+14!
                RESEND+2*,RESEND+3*,DSET+1*,DSET+2,DSET+3,DSET+4,DSET+5
   XMDUN        EXIT+2*,EXIT+14!
   XMDUZ        EXIT+2*,EXIT+14!
   XMER         UNREG+14,EXIT+14!,DELETE+1,UPDATE+1,DSET+1
   XMFROM       START+8,EXIT+14!,RESEND+5
   XMREC        UNREG+14,EXIT+15!,DELETE+1,UPDATE+1,RESEND+1,DSET+1
   XMRG         UNREG+2,UNREG+3,UNREG+4,UNREG+8,UNREG+11,UNREG+12,UNREG+14*
                UNREG+16,UNREG+17,UNREG+18,UNREG+19,UNREG+21,UNREG+23,UNREG+26
                UNREG+27,EXIT+15!,DELETE+1*,DELETE+2,DELETE+3,DELETE+4,DELETE+5
                DELETE+6,DELETE+7,OUT,UPDATE+1*,UPDATE+2,UPDATE+3
                UPDATE+4,UPDATE+5,UPDATE+6,RESEND+2,DSET+1
   XMSUB        EXIT+2*,EXIT+15!
   XMTEXT       EXIT+2*,EXIT+15!
   XMY          EXIT+5!,EXIT+8!,EXIT+15!
   XMY("G.CLOZAPINE DEBUG" 
                EXIT+9*
   XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   " 
                EXIT+6*
   XMY("G.CLOZAPINE ROLL-UP" 
                EXIT+8*
   XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   " 
                EXIT+5*
   XMZ          EXIT+15!
   XQDATE       START+8,EXIT+15!
   XQSUB        START+7,EXIT+15!
   Y            START+7,UNREG+9,UNREG+24,EXIT+4,EXIT+7,EXIT+15!,RESEND+2
                RESEND+3,RESEND+5*
   YSA          EXIT+15!
   YSACTION     START+11*,START+12*,START+13,EXIT+15!
   YSCL28       EXIT+16!
   YSCLA        EXIT+16!,DELETE+6*,DELETE+7,DELALL+1*,DELALL+2,DELALL+3
   YSCLAA       EXIT+16!
   YSCLB        EXIT+16!
   YSCLC        EXIT+16!
   YSCLDA       EXIT+16!,UPDATE+8*,UPDATE+9,UPDATE+11,UPDATE+12,UPDATE+13
                UPDATE+15
   YSCLDA1      EXIT+16!,UPDATE+14*
   YSCLDATA     EXIT+16!
   YSCLDEA1     EXIT+16!
   YSCLDFN      EXIT+17!,DELETE+4*,DELETE+5,DELETE+7
   YSCLDM       EXIT+17!
   YSCLDOC      EXIT+17!
   YSCLDOM      EXIT+17!
   YSCLDR       EXIT+17!
   YSCLDRA      EXIT+17!
   YSCLDRB      EXIT+17!
   YSCLDTA      EXIT+17!
   YSCLDUZ      EXIT+18!
   YSCLED       EXIT+18!,RESEND+3*
   YSCLER       UNREG+2*,UNREG+3*,UNREG+4*,UNREG+6*,UNREG+8*,UNREG+9*,UNREG+12*
                UNREG+16*,UNREG+17*,UNREG+18*,UNREG+19*,UNREG+21*,UNREG+23*
                UNREG+24*,UNREG+27*,EXIT+18!,DELETE+3*,DELETE+4*,DELETE+5*
                DELETE+6*,DELETE+8*,DELALL+2*,OUT,UPDATE+2*,UPDATE+3*
                UPDATE+4*,UPDATE+5*,UPDATE+7*,UPDATE+9*,UPDATE+10*,UPDATE+11*
                UPDATE+12*,UPDATE+15*,RESEND+2*,RESEND+3*,RESEND+5*
   YSCLERR      EXIT+17!
   YSCLFDA      EXIT+18!
   YSCLFRQ      EXIT+18!
>> YSCLLN       EXIT+4,EXIT+7
   YSCLLNT      START+17*,EXIT+18!,DELETE+1*,OUT*,DSET+3*,DSET+5*,DEBUG+2*
                DEBUG+5*
   YSCLNM       EXIT+18!,UPDATE+6*,UPDATE+7,UPDATE+10,UPDATE+12,UPDATE+13
                UPDATE+14,UPDATE+15
   YSCLOVR      EXIT+18!
   YSCLPT       UNREG+9*,UNREG+11,UNREG+24*,UNREG+26,EXIT+19!
   YSCLRPT      EXIT+19!
   YSCLRX       EXIT+20!
   YSCLSAND     EXIT+20!
   YSCLSD1      EXIT+19!
   YSCLSDT      EXIT+19!,RESEND+3*,RESEND+5
   YSCLSITE     EXIT+18!
   YSCLSSN      EXIT+19!,UPDATE+6*,UPDATE+8,UPDATE+11,UPDATE+12
   YSCLST       START+3*,START+8,START+13,EXIT+2,EXIT+19!,OUT
   YSCLSTN      START+4*,EXIT+19!,DEBUG+2,DEBUG+5
   YSCLSUB      START+7*,START+8,START+11,START+12,START+17,START+19,START+22
                START+23,START+25,START+26,START+27,START+28,START+29,START+30
                START+31,START+32,START+33,START+34,EXIT+2,EXIT+6,EXIT+9
                EXIT+19!,DEBUG+1,DEBUG+4
   YSCLTC       EXIT+19!
   YSCLTYPE     EXIT+15!
   YSCLWB       EXIT+20!,UPDATE+6*,UPDATE+14,UPDATE+15
   YSCLX        UNREG+8*,UNREG+12*,UNREG+23*,UNREG+27*,EXIT+20!
   YSCLYN       EXIT+20!
   YSDEBUG      START+2*,START+8,START+13,EXIT+1*,EXIT+2,EXIT+6,EXIT+9,EXIT+20!
                DEBUG+2,DEBUG+5
   YSI          EXIT+20!
   YSOFF        EXIT+20!,DSET+2*,DSET+3
   YSPR         EXIT+20!
   ZTQUEUED     EXIT+20!
   ZTSK         EXIT+20!,RESEND+5

Global Variables  ( * Changed  ! Killed)
   ^%ZOSF("PROD"       EXIT+4,EXIT+7
   ^%ZOSF("UCI"        EXIT+4
   ^%ZOSF("UPPERCASE"  START+7
   ^DD("DD"            RESEND+5
   ^DPT(               UNREG+8,UNREG+12,UNREG+23,UNREG+27,DELALL+2,UPDATE+12
                       UPDATE+15
   ^DPT("SSN"          UNREG+6,UNREG+21,DELETE+4,UPDATE+8,UPDATE+11
   ^TMP($J             START+1!,START+8*,START+13*,EXIT+13!,OUT*,DSET+3*
                       DSET+5*,DEBUG+2*,DEBUG+5*
   ^YSCL(603.01        UNREG+8,UNREG+12,UNREG+23,UNREG+27,DELETE+3,DELETE+5
                       DELETE+6,DELETE+7!,DELALL+1,DELALL+2,DELALL+3!,UPDATE+7
                       UPDATE+10,UPDATE+12,UPDATE+13,UPDATE+14*
   ^YSCL(603.03        START+2,EXIT+1,DSET+4*,DEBUG+3*,DEBUG+6*

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   DEBUG        START+26
   DELALL       DELETE+2
   DELETE       START+17
   DSET         START+25
   EXIT         DELETE+10,REPORT+1,REBUILD+1,UPDATE+16,RESEND+2,RESEND+3
                RESEND+6,DSET+3,DSET+6,DEBUG+7
   OUT          UNREG+2,UNREG+3,UNREG+4,UNREG+6,UNREG+8,UNREG+9,UNREG+12
                UNREG+16,UNREG+17,UNREG+18,UNREG+19,UNREG+21,UNREG+23,UNREG+24
                UNREG+27,DELETE+3,DELETE+4,DELETE+5,DELETE+6,DELETE+8,DELALL+2
                UPDATE+2,UPDATE+3,UPDATE+4,UPDATE+5,UPDATE+7,UPDATE+9
                UPDATE+10,UPDATE+11,UPDATE+12,UPDATE+15,RESEND+2,RESEND+3
                RESEND+5
   REPORT       START+19
   RESEND       START+22
   UNREG        START+6
   UPDATE       START+23

External References
   ^%DT                RESEND+2
   H^%DTC              RESEND+3
   YMD^%DTC            EXIT+2
   MIX^DIC1            UNREG+9,UNREG+24
   FILE^DICN           UNREG+11,UNREG+26
   $$SITE^VASITE       START+3,START+4
   ^XMD                EXIT+11
   CL1API^YSCLSRV2     START+33
   CLAPI^YSCLSRV2      START+32
   DCON^YSCLSRV2       START+34
   OVRRID^YSCLSRV2     START+31
   REBUILD^YSCLSRV2    REBUILD+1
   REPORT^YSCLSRV2     REPORT+1
   ^YSCLSRV3           START+27
   AUTH^YSCLSRV3       START+30
   DEMOG^YSCLSRV3      START+29
   LOCK^YSCLSRV3       START+28
   SERV^YSCLTST2       RESEND+4

*****   END   *****

   Press return to continue:

YSCLSRV1 * *  32 Lines,  1375 Bytes, Checksum: B2721045
                                                  Jun 17, 2016@09:20:58 page 5
              286 bytes in comments
YSCLSRV1 ;DALOI/RLM-Clozapine data server ;24 APR 1990
         ;;5.01;MENTAL HEALTH;**61,69,74,90,122**;Dec 30, 1994;Build 18
         ; Reference to ^%ZOSF supported by IA #10096
         ; Reference to ^XMD supported by IA #10070
CSUM     ;Calculate checksum for routines and transmit errors to Forum
         S X=$T(+0) X ^%ZOSF("RSUM") S ^TMP("YSCL",$J,2,0)="YSCLSRV1 at "_YSCLST
          _" = "_Y
         F YSI=1:1 S YSA=$T(ROU+YSI) Q:YSA["***"  S X=$P($P(YSA,","),";",3) D
          . X ^%ZOSF("TEST") I '$T S ^TMP("YSCL",$J,YSI+3,0)=X_" is missing." Q
          . X ^%ZOSF("RSUM") S ^TMP("YSCL",$J,YSI+3,0)=X_" should be "_$P(YSA,",
          ",2)_" is "_Y
         ;/RBN - Begin modifications for YS*5.01*122
         X ^%ZOSF("UCI") I Y=^%ZOSF("PROD") D
         . K XMY S XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   ")=""
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")=""
         I Y'=^%ZOSF("PROD") D
         . K XMY S XMY("G.CLOZAPINE ROLL-UP")=""
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
         ;/RBN - End modifications for YS*5.01*122
         S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine Checksum data at "_YSCLST_
          " run on "_XQDATE
         S XMTEXT="^TMP(""YSCL"",$J,",XMDUZ="CLOZAPINE MONITOR" D ^XMD
         K %DT,YSA,YSCLST,YSI,X,XMDUZ,XMSUB,XMTEXT,Y
         K ^TMP("YSCL",$J)
         Q
ROU      ;
         ;;YSCLSERV,25564583
         ;;YSCLSRV2,24723007
         ;;YSCLSRV3,24872037
         ;;YSCLTEST,12378003
         ;;YSCLTST1,11839450
         ;;YSCLTST2,32098862
         ;;YSCLTST3,25645207
         ;;***
ZEOR     ;YSCLSRV1

*****   INDEX OF YSCLSRV1   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %DT          CSUM+15!
   X            CSUM+1*,CSUM+2*,CSUM+3,CSUM+4,CSUM+15!
   XMDUZ        CSUM+14*,CSUM+15!
   XMSUB        CSUM+13*,CSUM+15!
   XMTEXT       CSUM+14*,CSUM+15!
   XMY          CSUM+7!,CSUM+8!,CSUM+10!,CSUM+11!
   XMY("G.CLOZAPINE DEBUG" 
                CSUM+11*
   XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   " 
                CSUM+8*
   XMY("G.CLOZAPINE ROLL-UP" 
                CSUM+10*
   XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   " 
                CSUM+7*
>> XQDATE       CSUM+13
   Y            CSUM+1,CSUM+4,CSUM+6,CSUM+9,CSUM+15!
   YSA          CSUM+2*,CSUM+4,CSUM+15!
   YSCLST       CSUM+1,CSUM+13,CSUM+15!
>> YSDEBUG      CSUM+8,CSUM+11,CSUM+13
   YSI          CSUM+2*,CSUM+3,CSUM+4,CSUM+15!

Global Variables  ( * Changed  ! Killed)
   ^%ZOSF("PROD"       CSUM+6,CSUM+9
   ^%ZOSF("RSUM"       CSUM+1,CSUM+4
   ^%ZOSF("TEST"       CSUM+3
   ^%ZOSF("UCI"        CSUM+6
   ^TMP("YSCL"         CSUM+1*,CSUM+3*,CSUM+4*,CSUM+16!

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   $T(          CSUM+1
   $T(ROU+YSI   CSUM+2

Label References
   NONE

External References
   ^XMD                CSUM+14

*****   END   *****

   Press return to continue:

YSCLTST2 * *  168 Lines,  11603 Bytes, Checksum: B106699391
                                                  Jun 17, 2016@09:20:58 page 6
              706 bytes in comments
YSCLTST2 ;DALOI/LB/RLM-TRANSMIT RX AND lAB DATA FOR CLOZAPINE ; 1/8/16 6:50pm
         ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122**;Dec 30, 1994;Bu
          ild 7
         ; Reference to ^LAB(60 supported by IA #333
         ; Reference to ^PSDRUG supported by IA #25
         ; Reference to ^XMD supported by IA #10070
         ; 
TRANSMIT ; send remote and local, kill and quit
         K XMZ S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2),YSCLSITE=$P($$SITE
          ^VASITE,"^",2)
         S $P(YSSTOP,",",7)=7 I $$S^%ZTLOAD D ABORT^YSCLTEST G END
         S YSDEBUG=$P(^YSCL(603.03,1,0),U,3)
         ;/RBN - Begin modifications for YS*5.01*122
         X ^%ZOSF("UCI")
         I Y=^%ZOSF("PROD") D
         .D:$G(YSCLLN)
         ..K XMY
         ..S XMY("S.RUCLRXLAB@DNS     .MED.DNS   ")=""
         ..I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")="",XM
          Y("G.RUCLRXLAB@FO-DALLAS.MED.DNS   ")=""
         ..S XMDUZ="Clozapine MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG
           ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW D ^
          XMD
         .K XMY
         .S XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   ")=""
         .I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")=""
         .S XMY("G.PSOCLOZ")=""
         .S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" o
          n "_DT_" at "_YSCLNOW
         .S ^TMP("YSCL",$J,2,0)=" ",^TMP("YSCL",$J,3,0)="In message # "_$S($D(XM
          Z):XMZ,1:"no data sent")
         .K XMZ S XMDUZ="Clozapine MONITOR",^TMP("YSCL",$J,1,0)="Clozapine lab d
          ata was transmitted, "_(YSCLLN)_" records were sent",XMTEXT="^TMP(""YS
          CL"",$J," D ^XMD
         I Y'=^%ZOSF("PROD") D
         .I $G(YSCLLN) D
         ..K XMY
         ..S XMY("S.RUCLRXLAB@NCCLAB2.AAC.DNS   ")="" ;XMY("G.CLOZAPINE ROLL-UP"
          )="" ;,
         ..I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
         ..S XMDUZ="Clozapine MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG
           ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW D ^
          XMD
         .K XMY
         .S ^TMP("YSCL",$J,2,0)=" ",^TMP("YSCL",$J,3,0)="In message # "_$S($D(XM
          Z):XMZ,1:"no data sent")
         .S XMY("G.CLOZAPINE ROLL-UP")=""
         .I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
         .S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" o
          n "_DT_" at "_YSCLNOW
         .K XMZ S ^TMP("YSCL",$J,1,0)="Clozapine lab data was transmitted, "_YSC
          LLN_" records were sent",XMTEXT="^TMP(""YSCL"",$J," D ^XMD
         S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT
         ;/RBN - End modifications for YS*5.01*122
END      ;
         G END1^YSCLTST3
         Q
         ;
REXMIT   ; retransmit lab and RX data
         ; must be a tuesday
         S DIR(0)="Y",DIR("A")="Are you sure you wish to retransmit lab data"
         D ^DIR K DIR I Y'=1 K Y Q
DATE     S %DT="AEXP",%DT(0)=-DT,%DT("A")="Ending date for data collection (must
           be a tuesday )"
         D ^%DT K %DT G END:X="^",END:X="^" I Y=-1 G DATE
SERV     S YSCLED=Y,X=Y D H^%DTC I %H#7'=1 W !,"MUST BE A TUESDAY" G DATE
         S ZTDESC="Server triggered retransmission"
         S ZTSAVE("YSCLED")="",ZTIO="",ZTRTN="REXMIT^YSCLTEST",ZTDTH=$H  ;;D ^%Z
          TLOAD G END
         D REXMIT^YSCLTEST  G END
FLSET    ;Set up file 603.02
         W @IOF,"This option specifies the blood tests associated with the Cloza
          pine"
         W !,"reporting software.  Two tests must be defined.  The first is the 
          White"
         W !,"Blood Count.  The second is the Granulocyte (or Neutrophil) percen
          tage."
         K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be
           used to record the White Blood Count for the",DIR("A")="Clozapine pat
          ients: " D ^DIR
         Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
         S YSCLWBC=+Y
         K DIR W !! S DIR(0)="PA^64:EMZ",DIR("A",1)="Enter the test that will be
           used to record the Neutrophil Count (percentage)",DIR("A")=" for the 
          Clozapine patients: " D ^DIR
         Q:Y=-1!($D(DUOUT))!($D(DTOUT))!($D(DIRUT))!($D(DIROUT))
         S YSCLGRN=+Y
         I YSCLWBC,YSCLGRN S ^YSCL(603.02,1,0)=YSCLWBC_"^"_YSCLGRN,$P(^YSCL(603.
          02,0),"^",3,4)="1^1"
         ;Only one entry is allowed.
         K DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC
         Q
EN(DRG)  ;
         K LAB I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")'="PSOCLO1" S LAB("NOT")=0 Q
         I $P($G(^PSDRUG(DRG,"CLOZ1")),"^")="PSOCLO1" D
          . S (CNT,I)=0 F  S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I  S CNT=$G(CNT)+1
          . I CNT'=2 S LAB("BAD TEST")=0 K CNT Q
          . K CNT F I=0:0 S I=$O(^PSDRUG(DRG,"CLOZ2",I)) Q:'I  D
          . . S LABT=$S($P(^PSDRUG(DRG,"CLOZ2",I,0),"^",4)=1:"WBC",1:"ANC"),LAB(
          LABT)=$P(^PSDRUG(DRG,"CLOZ2",I,0),"^")_"^"_$P(^(0),"^",3)_"^"_$P(^(0),
          "^",4)
         K LABT,I
         Q
CL1(DFN,DAYS) --
          ;The routine was split due to size
         G CL1^YSCLTST4
         Q
         ;
CL(DFN)  ;
         K ^TMP("LRRR",$J) N RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWB
          C,YSCLRWBC,YSCLFRQ
         I 'DFN Q "-1^-1^-1^-1^-1^-1^-1"
         S YSCLFRQ=$O(^YSCL(603.01,"C",DFN,"")) I YSCLFRQ]""  S YSCLFRQ=$P(^YSCL
          (603.01,YSCLFRQ,0),"^",3)
         I $G(^YSCL(603.03,1,1))=1!(YSCLFRQ="")  Q "-1^0^0^0^0^0^"_YSCLFRQ
         I $P($G(^PS(55,DFN,"SAND")),"^",2)'="A"  Q "-1^0^0^0^0^0^"_YSCLFRQ
         S X1=DT,X2="-7" D C^%DTC S YSCLSD=X
         S YSCLA=0 F  S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA  S YSCLTLS=^Y
          SCL(603.04,1,1,YSCLA,0),YSCLTLS($P(YSCLTLS,"^",2),$P(YSCLTLS,"^",1))=$
          P(YSCLTLS,"^",3)
         S YSCLTL="",PSJCNT=0 F  S YSCLTL=$O(^YSCL(603.04,1,1,"B",YSCLTL)) Q:'YS
          CLTL  D
          . D RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
          . S YSCLSB1="" F  S YSCLSB1=$O(^TMP("LRRR",$J,DFN,YSCLSB1)) Q:YSCLSB1=
          ""  D
          . . S YSCLTDT="" F  S YSCLTDT=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT)) 
          Q:YSCLTDT=""  I $P(YSCLTDT,".",2)]"" D
          . . . S YSCLTA="" F  S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YS
          CLTA)) Q:YSCLTA=""  I YSCLTA D
          . . . . S RESULTS1=^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)
          . . . . S RESULTS(YSCLTL,YSCLTDT)=$P(RESULTS1,"^",2)
         ;Find all entries for WBC and sort by inverse date.
         S YSCLA="" F  S YSCLA=$O(YSCLTLS("W",YSCLA)) Q:'YSCLA  S YSCLXWBC(YSCLA
          )="" D
          . S YSCLA1="" F  S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1  S YSCLY
          WBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$P($G(^LAB(60,YSCLA,0)),"^")_"^"
          _YSCLTLS("W",YSCLA)
         I '$D(YSCLYWBC) G ALTANC
         I $D(YSCLXWBC),$D(YSCLYWBC) D
         .S YSCLRWBC=$O(YSCLYWBC(0)) I 'YSCLRWBC ;D KILL Q "0^^^^^^"_YSCLFRQ
         .S YSCLMULT=$P(YSCLYWBC(YSCLRWBC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1)
         .S YSCLRWBC(YSCLRWBC)=($P(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$P(YSCL
          YWBC(YSCLRWBC),"^",2)
         .;Scan for Neutrophil count on same day and time as most recent WBC
         .S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" Q:YSCLMTCH  F  S YSC
          LTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT  D  Q:YSCLMTCH
         ..S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1)
          ..I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRWBC)'
          ?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMU
          LT_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q
          ..I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRWBC)'
          ?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSC
          LTPT,YSCLRWBC))*.01)_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q
          ..I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRWBC)'
          ?1A.E D
          ...S YSCLSGS="" F  S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D  Q:YSCLMTCH
          ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(
          YSCLSGS,YSCLRWBC)=0
          ....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLT
          PT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$P(^LAB(60,YSCL
          TPT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
          ..I $D(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRWBC)'
          ?1A.E D
          ...S YSCLSGS="" F  S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D  Q:YSCLMTCH
          ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(
          YSCLSGS,YSCLRWBC)=0
          ....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMU
          LT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^
          ")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
         D KILL
         I '$G(YSCLRWBC(YSCLRWBC)),'+$G(YSCLRANC(YSCLRWBC)) Q "0^^^^^^"_YSCLFRQ
         I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWB
          C(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRW
          BC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
         I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRW
          BC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLR
          WBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
         I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC)) Q "0^"_$G(YSCLRWBC(YS
          CLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC))
          )_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
         I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1500 Q "2^"_$G(YSCLRWB
          C(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRW
          BC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
         ;;END NCC REMEDIATION << RJS*122
         Q "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)
          _"^"_YSCLFRQ
         ;
         ;;START NCC REMEDIATION >> RJS*122
ALTANC   ;
         S YSCLA=0 F  S YSCLA=$O(YSCLTLS("A",YSCLA)) Q:'YSCLA  S YSCLXANC(YSCLA)
          ="" D
         .S YSCLA1=0 F  S YSCLA1=$O(RESULTS(YSCLA,YSCLA1)) Q:'YSCLA1  S YSCLYANC
          (YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$P($G(^LAB(60,YSCLA,0)),"^")_"^"_YS
          CLTLS("A",YSCLA)
         I $D(YSCLYANC) D
         .S (YSCLRANC,YSCLRWBC)=$O(YSCLYANC(0)) I 'YSCLRANC ;D KILL Q "0^^^^^^"_
          YSCLFRQ
         .S YSCLMULT=$P(YSCLYANC(YSCLRANC),"^",3),YSCLMULT=$S(YSCLMULT:1000,1:1)
         .S YSCLRANC(YSCLRANC)=($P(YSCLYANC(YSCLRANC),"^")*YSCLMULT)_"^"_$P(YSCL
          YANC(YSCLRANC),"^",2)
         .;Scan for Neutrophil count on same day and time as most recent ANC
         .S YSCLMTCH=0 F YSCLA="A","N","S","T" S YSCLTPT="" Q:YSCLMTCH  F  S YSC
          LTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT  D  Q:YSCLMTCH
         ..S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1)
         ..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRANC)'?
          1A.E S YSCLMTCH=1,YSCLRANC(YSCLRANC)=RESULTS(YSCLTPT,YSCLRANC)*YSCLMUL
          T_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q
         ..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRANC)'?
          1A.E S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCL
          TPT,YSCLRANC))*.01)_"^"_$P(^LAB(60,YSCLTPT,0),"^") Q
         ..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRANC)'?
          1A.E D
         ...S YSCLSGS="" F  S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D  Q:YSCLMTCH
         ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRANC)) S RESULTS(Y
          SCLSGS,YSCLRANC)=0
         ....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTP
          T,YSCLRANC)*.01)+(RESULTS(YSCLSGS,YSCLRANC)*.01))_"^"_$P(^LAB(60,YSCLT
          PT,0),"^")_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
         ..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRANC)'?
          1A.E D
         ...S YSCLSGS="" F  S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D  Q:YSCLMTCH
         ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRANC)) S RESULTS(Y
          SCLSGS,YSCLRANC)=0
         ....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=((RESULTS(YSCLTPT,YSCLRANC)*YSCLMUL
          T)+(RESULTS(YSCLSGS,YSCLRANC)*YSCLMULT))_"^"_$P(^LAB(60,YSCLTPT,0),"^"
          )_"/"_$P($G(^LAB(60,YSCLSGS,0)),"^") Q
         .S YSCLRWBC(YSCLRWBC)="^WBC"
         D KILL
         I '$G(YSCLRANC(+$G(YSCLRWBC))) Q "0^^^^^^"_YSCLFRQ
         I +$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(
          YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCL
          RWBC)_"^"_YSCLFRQ
         I +$G(YSCLRANC(YSCLRWBC))<1500 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(
          YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCL
          RWBC)_"^"_YSCLFRQ
         Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G
          (YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
         ;;END NCC REMEDIATION << RJS*122
         ;
KILL     ;
         ;Q:$D(PSLAST7)  ;RTW
         K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD
          ,YSCLTA,YSCLMULT
         K YSCLTL,YSCLTLS,X1,X2
         Q
         ;
OVERRIDE(DFN) --
          ;Check for an over-ride.   SEE RQ12.11
         S YSCLOVR=$O(^YSCL(603.01,"C",DFN,""))
         Q:YSCLOVR="" 0
         S YSCLOVR=$P(^YSCL(603.01,YSCLOVR,0),"^",4)
         S:YSCLOVR'=DT ANQRE=""
         I $G(YSCLOVR),DT>YSCLOVR S X=YSCLOVR,YSCXDATE=$$FMTE^XLFDT(X,"D") W !,"
          National Override expired at midnight on "_YSCXDATE
         Q YSCLOVR=DT
ZEOR     ;YSCLTST2

*****   INDEX OF YSCLTST2   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %DT          TRANSMIT+1*,DATE*,DATE+1!
   %DT("A"      DATE*
   %DT(0        DATE*
>> %H           SERV
>> ANQRE        OVERRIDE+4*
   CNT          EN+3*,EN+4!,EN+5!
   DAYS         CL1~
   DFN          CL1~,CL~,CL+2,CL+3,CL+5,CL+9,CL+10,CL+11,CL+12,CL+13,OVERRIDE~
                OVERRIDE+1
   DIR          REXMIT+3!,FLSET+4!,FLSET+7!,FLSET+12!
   DIR("A"      REXMIT+2*,FLSET+4*,FLSET+7*
   DIR(0        REXMIT+2*,FLSET+4*,FLSET+7*
>> DIROUT       FLSET+5,FLSET+8
>> DIRUT        FLSET+5,FLSET+8
   DRG          EN~,EN+1,EN+2,EN+3,EN+5,EN+6
   DT           TRANSMIT+11,TRANSMIT+16,TRANSMIT+24,TRANSMIT+29,DATE,CL+6,CL+9
                OVERRIDE+4,OVERRIDE+5,OVERRIDE+6
>> DTOUT        FLSET+5,FLSET+8
>> DUOUT        FLSET+5,FLSET+8
   FDA          KILL+2!
   I            EN+3*,EN+5*,EN+6,EN+7!
   IOF          FLSET+1
   LAB          EN+1!
   LAB(         EN+6*
   LAB("BAD TEST" 
                EN+4*
   LAB("NOT"    EN+1*
   LABT         EN+6*,EN+7!
>> PSJCNT       CL+8*
   RESULTS      CL+1~,KILL+2!
   RESULTS(     CL+14*,CL+17,CL+26,CL+27,CL+28,CL+30*,CL+31,CL+32,CL+34*,CL+35
                ALTANC+2,ALTANC+10,ALTANC+11,ALTANC+12,ALTANC+14*,ALTANC+15
                ALTANC+16,ALTANC+18*,ALTANC+19
   RESULTS1     CL+13*,CL+14,KILL+2!
   U            TRANSMIT+3
   X            TRANSMIT+1*,DATE+1,SERV*,FLSET+12!,CL+6,OVERRIDE+5*
   X1           CL+6*,KILL+3!
   X2           CL+6*,KILL+3!
>> XMDUZ        TRANSMIT+11*,TRANSMIT+18*,TRANSMIT+24*
>> XMSUB        TRANSMIT+11*,TRANSMIT+16*,TRANSMIT+24*,TRANSMIT+29*
>> XMTEXT       TRANSMIT+11*,TRANSMIT+18*,TRANSMIT+24*,TRANSMIT+30*
   XMY          TRANSMIT+8!,TRANSMIT+10!,TRANSMIT+12!,TRANSMIT+14!,TRANSMIT+21!
                TRANSMIT+23!,TRANSMIT+25!,TRANSMIT+28!
   XMY("G.CLOZAPINE DEBUG" 
                TRANSMIT+23*,TRANSMIT+28*
   XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   " 
                TRANSMIT+10*,TRANSMIT+14*
   XMY("G.CLOZAPINE ROLL-UP" 
                TRANSMIT+27*
   XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   " 
                TRANSMIT+13*
   XMY("G.PSOCLOZ" 
                TRANSMIT+15*
   XMY("G.RUCLRXLAB@FO-DALLAS.MED.DNS   " 
                TRANSMIT+10*
   XMY("S.RUCLRXLAB@DNS     .MED.DNS   " 
                TRANSMIT+9*
   XMY("S.RUCLRXLAB@NCCLAB2.AAC.DNS   " 
                TRANSMIT+22*
   XMZ          TRANSMIT+1!,TRANSMIT+17,TRANSMIT+18!,TRANSMIT+26,TRANSMIT+30!
   Y            TRANSMIT+1,TRANSMIT+6,TRANSMIT+19,REXMIT+3!,DATE+1,SERV,FLSET+5
                FLSET+6,FLSET+8,FLSET+9,FLSET+12!
   Y15          KILL+2!
   YSCLA        CL+7*,CL+16*,CL+17,CL+24*,CL+25,CL+26,CL+27,CL+28,CL+32
                ALTANC+1*,ALTANC+2,ALTANC+8*,ALTANC+9,ALTANC+10,ALTANC+11
                ALTANC+12,ALTANC+16,KILL+2!
   YSCLA1       CL+17*,ALTANC+2*,KILL+2!
>> YSCLED       SERV*
   YSCLFRQ      CL+1~,CL+3*,CL+4,CL+5,CL+37,CL+38,CL+39,CL+40,CL+41,CL+43
                ALTANC+22,ALTANC+23,ALTANC+24,ALTANC+25
   YSCLGRN      FLSET+9*,FLSET+10,FLSET+12!
>> YSCLLN       TRANSMIT+7,TRANSMIT+18,TRANSMIT+20,TRANSMIT+30
   YSCLMTCH     CL+24*,CL+26*,CL+27*,CL+29,CL+31*,CL+33,CL+35*,ALTANC+8*
                ALTANC+10*,ALTANC+11*,ALTANC+13,ALTANC+15*,ALTANC+17,ALTANC+19*
                KILL+2!
   YSCLMULT     CL+21*,CL+22,CL+25*,CL+26,CL+35,ALTANC+5*,ALTANC+6,ALTANC+9*
                ALTANC+10,ALTANC+19,KILL+2!
>> YSCLNOW      TRANSMIT+1*,TRANSMIT+11,TRANSMIT+16,TRANSMIT+24,TRANSMIT+29
>> YSCLOVR      OVERRIDE+1*,OVERRIDE+2,OVERRIDE+3*,OVERRIDE+4,OVERRIDE+5
                OVERRIDE+6
   YSCLRANC     CL+1~,ALTANC+4*,ALTANC+5,ALTANC+6,ALTANC+10,ALTANC+11,ALTANC+12
                ALTANC+14,ALTANC+15,ALTANC+16,ALTANC+18,ALTANC+19
   YSCLRANC(    CL+26*,CL+27*,CL+31*,CL+35*,CL+37,CL+38,CL+39,CL+40,CL+41,CL+43
                ALTANC+6*,ALTANC+10*,ALTANC+11*,ALTANC+15*,ALTANC+19*,ALTANC+22
                ALTANC+23,ALTANC+24,ALTANC+25
   YSCLRWBC     CL+1~,CL+20*,CL+21,CL+22,CL+26,CL+27,CL+28,CL+30,CL+31,CL+32
                CL+34,CL+35,CL+37,CL+38,CL+39,CL+40,CL+41,CL+43,ALTANC+4*
                ALTANC+20,ALTANC+22,ALTANC+23,ALTANC+24,ALTANC+25
   YSCLRWBC(    CL+22*,CL+27,CL+31,CL+37,CL+38,CL+39,CL+40,CL+41,CL+43
                ALTANC+20*,ALTANC+23,ALTANC+24,ALTANC+25
   YSCLSB1      CL+10*,CL+11,CL+12,CL+13,KILL+2!
   YSCLSD       CL+6*,CL+9,KILL+2!
   YSCLSGS      CL+29*,CL+30*,CL+31,CL+33*,CL+34*,CL+35,ALTANC+13*,ALTANC+14*
                ALTANC+15,ALTANC+17*,ALTANC+18*,ALTANC+19,KILL+2!
>> YSCLSITE     TRANSMIT+1*,TRANSMIT+11,TRANSMIT+16,TRANSMIT+24,TRANSMIT+29
   YSCLTA       CL+12*,CL+13,KILL+2!
>> YSCLTDT      CL+11*,CL+12,CL+13,CL+14
   YSCLTL       CL+8*,CL+9,CL+14,KILL+3!
   YSCLTLS      CL+7*,KILL+3!
   YSCLTLS(     CL+7*,CL+24,CL+25,ALTANC+8,ALTANC+9
   YSCLTLS("A"  ALTANC+1,ALTANC+2
   YSCLTLS("B"  CL+29,ALTANC+13
   YSCLTLS("T"  CL+33,ALTANC+17
   YSCLTLS("W"  CL+16,CL+17
>> YSCLTPT      CL+24*,CL+25,CL+26,CL+27,CL+28,CL+31,CL+32,CL+35,ALTANC+8*
                ALTANC+9,ALTANC+10,ALTANC+11,ALTANC+12,ALTANC+15,ALTANC+16
                ALTANC+19
   YSCLWBC      FLSET+6*,FLSET+10,FLSET+12!
   YSCLXANC     CL+1~
   YSCLXANC(    ALTANC+1*
   YSCLXWBC     CL+1~,CL+19
   YSCLXWBC(    CL+16*
   YSCLYANC     CL+1~,ALTANC+3
   YSCLYANC(    ALTANC+2*,ALTANC+5,ALTANC+6
   YSCLYANC(0   ALTANC+4
   YSCLYWBC     CL+1~,CL+18,CL+19
   YSCLYWBC(    CL+17*,CL+21,CL+22
   YSCLYWBC(0   CL+20
>> YSCXDATE     OVERRIDE+5*
>> YSDEBUG      TRANSMIT+3*,TRANSMIT+10,TRANSMIT+11,TRANSMIT+14,TRANSMIT+16
                TRANSMIT+23,TRANSMIT+24,TRANSMIT+28,TRANSMIT+29
>> YSSTOP       TRANSMIT+2*
   ZTDESC       SERV+1*,FLSET+12!
>> ZTDTH        SERV+2*
>> ZTIO         SERV+2*
>> ZTRTN        SERV+2*
>> ZTSAVE("YSCLED" 
                SERV+2*

Global Variables  ( * Changed  ! Killed)
   ^%ZOSF("PROD"       TRANSMIT+6,TRANSMIT+19
   ^%ZOSF("UCI"        TRANSMIT+5
   ^LAB(60             CL+17,CL+26,CL+27,CL+31,CL+35,ALTANC+2,ALTANC+10
                       ALTANC+11,ALTANC+15,ALTANC+19
   ^PS(55              CL+5
   ^PSDRUG(            EN+1,EN+2,EN+3,EN+5,EN+6
   ^TMP("LRRR"         CL+1!,CL+10,CL+11,CL+12,CL+13
   ^TMP("YSCL"         TRANSMIT+17*,TRANSMIT+18*,TRANSMIT+26*,TRANSMIT+30*
   ^YSCL(603.01        CL+3,OVERRIDE+1,OVERRIDE+3
   ^YSCL(603.02        FLSET+10*
   ^YSCL(603.03        TRANSMIT+3,TRANSMIT+31*,CL+4
   ^YSCL(603.04        CL+7,CL+8

Naked Globals
   ^(0          EN+6

Cache Objects
   NONE

Marked Items
   NONE

Label References
   ALTANC       CL+18
   DATE         DATE+1,SERV
   END          TRANSMIT+2,DATE+1,SERV+3
   KILL         CL+36,ALTANC+21

External References
   ^%DT                TRANSMIT+1,DATE+1
   C^%DTC              CL+6
   H^%DTC              SERV
   $$S^%ZTLOAD         TRANSMIT+2
   ^DIR                REXMIT+3,FLSET+4,FLSET+7
   RR^LR7OR1           CL+9
   $$SITE^VASITE       TRANSMIT+1
   $$FMTE^XLFDT        OVERRIDE+5
   $$NOW^XLFDT         TRANSMIT+31
   ^XMD                TRANSMIT+11,TRANSMIT+18,TRANSMIT+24,TRANSMIT+30
   ABORT^YSCLTEST      TRANSMIT+2
   REXMIT^YSCLTEST     SERV+3
   END1^YSCLTST3       END+1
   CL1^YSCLTST4        CL1+1

*****   END   *****

   Press return to continue:

YSCLTST3 * *  141 Lines,  9174 Bytes, Checksum: B70181019
                                                  Jun 17, 2016@09:20:58 page 7
              914 bytes in comments
YSCLTST3 ;DALOI/LB/RLM-TRANSMISSION FOR CLOZAPINE REPORTING SYSTEM ;26 June 91
         ;;5.01;MENTAL HEALTH;**18,22,25,26,47,61,69,74,90,122**;Dec 30, 1994;Bu
          ild 18
         ; Reference to ^DPT supported by IA #10035
         ; Reference to ^PS(55 supported by IA #787
         ; Reference to ^PS(59 supported by IA #783
         ; Reference to ^VA(200 supported by IA #10060
         ; Reference to ^LAB(60 supported by IA #333
         ; Reference to ^XMD supported by IA #10070
DEMOG    ; Old entry point to send demographic data for patients from task. Obso
          lete
         Q
DMG      ; Called by YSCLTEST
         S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3)
         K ^TMP($J),^TMP("YSCL",$J),^TMP("YSCLL",$J) S YSCLLN=0,YSCLNO=20,DFN=0,
          YSCLIEN=0
         F  K YSCLA S YSCLIEN=$O(^YSCL(603.01,YSCLIEN)) Q:'YSCLIEN  S DFN=$P($G(
          ^YSCL(603.01,YSCLIEN,0)),"^",2) S $P(YSSTOP,",",8)=8 Q:$$S^%ZTLOAD  D:
          DFN
          . I $D(^DPT(DFN,0)),$D(^YSCL(603.01,YSCLIEN,0)) S YSCLC=$P($G(^YSCL(60
          3.01,YSCLIEN,0)),"^",1) D GET
         D TRANSMIT:YSCLLN G END
         ;
GET      ;
         S $P(YSSTOP,",",9)=9 Q:$$S^%ZTLOAD
         Q:'$D(^PS(55,DFN,"SAND"))  ;Don't try to transmit if no pharmacy record
         Q:$P(^PS(55,DFN,"SAND"),"^",4)  ;Don't retransmit demographics.
         Q:$D(^TMP("YSCLL",$J,DFN))
         S ^TMP("YSCLL",$J,DFN)=1
         S YSCLP=+$P($G(^PS(55,DFN,"SAND")),"^",5),YSCLDEA=$P($G(^VA(200,YSCLP,"
          PS")),"^",2),YSCLP=$P($G(^VA(200,YSCLP,0)),"^")
         D DEM^VADPT,ADD^VADPT S YSCL=YSCLC_"^"_$E($P(VADM(1),",",2))_$E(VADM(1)
          )_"^"_$P(VADM(3),"^")_"^"_$P(VADM(2),"^")_"^"_$P(VADM(5),"^")_"^"_VAPA
          (6)_"^"_DT
         D
          . S YSRACE="*"
          . S YSRC=0 F  S YSRC=$O(VADM(11,YSRC)) Q:'YSRC  S YSRACE=YSRACE_+VADM(
          11,YSRC)_"-"_+VADM(11,YSRC,1)_","
          . S YSRACE=YSRACE_"~"
          . S YSRC=0 F  S YSRC=$O(VADM(12,YSRC)) Q:'YSRC  S YSRACE=YSRACE_+VADM(
          12,YSRC)_"-"_+VADM(12,YSRC,1)_","
         S YSCL=YSCL_"^"_YSRACE_"^"_YSCLP_"^"_YSCLDEA
         S YSCLGL=$S($D(^PS(59)):"^PS",1:"^DIC")
         ;YSCLGL is used to indirectly hold the global reference for file 59. Th
          is is necessary due to changes in the file location. The $select may b
          e expanded to cover future moves. DBIA 273-B
         F YSCLJ=0:0 S YSCLJ=$O(@YSCLGL@(59,YSCLJ)) Q:'YSCLJ  I $D(^(YSCLJ,"SAND
          ")) S YSCLJ=$P(^(0),"^",5) Q
         S YSCL=YSCL_"^"_YSCLJ
         ;registration number^initials^dob^ssn^sex^zip^today^race^physician^dea^
          zip code (hosp)
         S YSCLLN=YSCLLN+1,^TMP($J,YSCLLN,0)=YSCL
         I VADM(5)=""!(VAPA(6)="")!('VADM(11))!('VADM(12)) D  ;RLM RACETEST
          . S ^TMP("YSCL",$J,YSCLNO,0)=$P(VADM(2),"^",1)_"   "_VADM(1)
          . S:VADM(5)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (SE
          X)"
          . S:VAPA(6)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ZI
          P)"
          . S:'VADM(12) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (RAC
          E, NEW FORMAT)"
          . S:'VADM(11) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ETH
          NICITY)"
          . S YSCLNO=YSCLNO+1
          . S ^TMP("YSCLL",$J,DFN)=0 ; leave unmarked pending demographic data
          . I ('VADM(11))!('VADM(12)) D
          . . S ^TMP("YSCL",$J,YSCLNO,0)="NOTE: Race and Ethnicity may be entere
          d if permission is obtained in the informed consent",YSCLNO=YSCLNO+1
          . . S ^TMP("YSCL",$J,YSCLNO,0)="document. See VHA Directive 99-035.",Y
          SCLNO=YSCLNO+1
         ;
         Q
         ;
TRANSMIT ; remote and local messages
         S $P(YSSTOP,",",10)=10 Q:$$S^%ZTLOAD
         S YSDEBUG=$P(^YSCL(603.03,1,0),U,3)
         ;/RBN - Begin modifications for YS*5.01*122
         X ^%ZOSF("UCI") I Y=^%ZOSF("PROD"),YSCLLN D
         . S XMY("S.RUCLDEM@DNS     .MED.DNS   ")=""
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")="",XM
          Y("G.RUCLDEM@FO-DALLAS.MED.DNS   ")=""
         . S XMDUZ="CLOZAPINE MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG
           ",1:"")_"Clozapine demographics" D ^XMD S $P(^YSCL(603.03,1,0),"^",6)
          =$$NOW^XLFDT
         . K XMY S XMY("G.PSOCLOZ")=""
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")=""
         I Y'=^%ZOSF("PROD"),YSCLLN D
         . S XMY("S.RUCLDEM@NCCLAB2.AAC.DNS   ")=""
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")="",XMY("G.RUCLDEM")=""
         . S XMDUZ="CLOZAPINE MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG
           ",1:"")_"Clozapine demographics" D ^XMD S $P(^YSCL(603.03,1,0),"^",6)
          =$$NOW^XLFDT
         . K XMY
         . S XMY("G.PSOCLOZ")=""
         . S XMDUZ="CLOZAPINE MONITOR",XMTEXT="^TMP($J,",XMSUB=$S(YSDEBUG:"DEBUG
           ",1:"")_"Clozapine demographics" D ^XMD S $P(^YSCL(603.03,1,0),"^",6)
          =$$NOW^XLFDT
         . I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
         S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine demographics",^TMP("YSCL",
          $J,2,0)=" ",XMDUZ="CLOZAPINE MONITOR",^TMP("YSCL",$J,1,0)="Clozapine d
          emographic data was transmitted, "_YSCLLN_" records were sent.",XMTEXT
          ="^TMP(""YSCL"",$J,"
         I $O(^TMP("YSCL",$J,10)) S ^TMP("YSCL",$J,3,0)="For the following patie
          nts, one or more of the required data",^TMP("YSCL",$J,4,0)="elements (
          race, sex, ZIP code) were missing.",^TMP("YSCL",$J,5,0)=" "
         I  S ^TMP("YSCL",$J,6,0)="Please have this information entered.",^TMP("
          YSCL",$J,7,0)="The available data was transmitted.",^TMP("YSCL",$J,8,0
          )=" "
         D ^XMD
         ; set transmitted field in 55 from ^TMP("YSCLL",$J)
         F DFN=0:0 S DFN=$O(^TMP("YSCLL",$J,DFN)) Q:'DFN  I ^TMP("YSCLL",$J,DFN)
           S DIE="^PS(55,",DA=DFN,DR="56///1" D ^DIE
         Q
         ;
FLERR    ;
         K XMY
         ;/RBN - Begin modifications for YS*5.01*122
         X ^%ZOSF("UCI") I Y=^%ZOSF("PROD") D
         .S XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   ")=""
         .I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   ")=""
         I Y'=^%ZOSF("PROD") D
         .S XMY("G.CLOZAPINE ROLL-UP")=""
         .I YSDEBUG K XMY S XMY("G.CLOZAPINE DEBUG")=""
         ;/RBN - End modifications for YS*5.01*122
         S %DT="T",X="NOW" D ^%DT S YSCLNOW=$P(Y,".",2)
         S YSCLSITE=$P($$SITE^VASITE,"^",2)
         S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data error at "_YSCLSI
          TE_" on "_DT_" at "_YSCLNOW,^TMP("YSCL",$J,1,0)=" "
         S ^TMP("YSCL",$J,2,0)="### Clozapine data error at "_YSCLSITE_" on "_DT
          _" +++"
         S ^TMP("YSCL",$J,3,0)=" Clozapine Lab Test file not properly defined."
         S ^TMP("YSCL",$J,4,0)=" Data cannot be transmitted!"
         S XMTEXT="^TMP(""YSCL"",$J,",XMDUZ="Clozapine MONITOR" D ^XMD
         G END^YSCLTST2
         Q
TLIST    ;
         I '$D(^YSCL(603.04)) W !,"Patch YS*5.01*90 not properly installed.  Con
          tact IRM" S DIR(0)="E" D ^DIR Q
         W !,"Currently linked Tests:" I '$O(^YSCL(603.04,1,1,0)) W !,"No tests 
          linked",!
         S YSCLA=0
         F  S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA  S YSCLB=^YSCL(603.04,1
          ,1,YSCLA,0) D
          . W !,$P(^LAB(60,$P(YSCLB,"^"),0),"^")," represents " S YSCLB=$P(YSCLB
          ,"^",2)
          . W $S(YSCLB="W":"WHITE BLOOD COUNT",YSCLB="A":"ABSOLUTE NEUTROPHIL CO
          UNT",YSCLB="N":"NEUTROPHIL PERCENT",YSCLB="S":"SEGS %",YSCLB="B":"BAND
          S %",YSCLB="T":"BANDS ABSOLUTE",YSCLB="C":"SEGS ABSOLUTE",1:"Bad Recor
          d")
         F  K DIR S DIR(0)="PA^60:EMZ",DIR("A")="Enter the name of the test for 
          Clozapine: " W ! D ^DIR Q:Y="^"!($D(DTOUT))!($D(DUOUT))  S YSCLTST=+Y 
          D  Q:Y="^"!($D(DTOUT))!($D(DUOUT))
          . I $D(^YSCL(603.04,1,1,"B",YSCLTST)) G TEXIST
          . K DIR S DIR(0)="SA^W:WHITE BLOOD COUNT;A:ABSOLUTE NEUTROPHIL COUNT;N
          :NEUTROPHIL PERCENT;S:SEGS %;B:BANDS %;T:BANDS ABSOLUTE;C:SEGS ABSOLUT
          E"
          . S DIR("A")="Enter the type of the test for Clozapine: "  D ^DIR Q:Y[
          "^"!($D(DTOUT))!($D(DUOUT))  S YSCLTS1=Y
          . K DIR S DIR(0)="SA^0:uL;1:K/uL;2:Percent"
          . S DIR("A")="Enter the reporting method of the test for Clozapine: " 
           D ^DIR Q:Y["^"!($D(DTOUT))!($D(DUOUT))  S YSCLTS2=Y
          . K YSCLERR
          . D VAL^DIE(603.41,"+1,1,",.01,"F","`"_YSCLTST,.YSCLRES,"FDA","YSCLERR
          ")
          . I $D(YSCLERR) W !,"There was a problem with the data, please re-ente
          r it" Q
          . D VAL^DIE(603.41,"+1,1,",1,"F",YSCLTS1,.YSCLRES,"FDA","YSCLERR")
          . I $D(YSCLERR) W !,"There was a problem with the data, please re-ente
          r it" Q
          . D VAL^DIE(603.41,"+1,1,",2,"F",YSCLTS2,.YSCLRES,"FDA","YSCLERR")
          . I $D(YSCLERR) W !,"There was a problem with the data, please re-ente
          r it" Q
          . D UPDATE^DIE(,"FDA",,"ERROR")
          . I $D(YSCLERR) W !,"There was a problem with the data, please re-ente
          r it" Q
         Q
TEXIST   ;
         W !,"This entry already exists.  Do you wish to delete it?" K DIR S DIR
          (0)="Y" D ^DIR Q:'Y!($D(DTOUT))!($D(DUOUT))
         S DA(1)=1,DA=$O(^YSCL(603.04,1,1,"B",YSCLTST,"")),DIE="^YSCL(603.04,1,1
          ,",DR=".01////@" D ^DIE W !,"Deleted" S Y="" Q
         Q
END      K %,C,D,DA,DFN,DISYS,DR,I,R,VADM,VAPA,VAERR,Y,YSCL,YSCL1,YSCL2,YSCLC,YS
          CLDEA,YSCLJ,YSCLLN,YSCLNAME,YSCLNO,YSCLP,^TMP($J),^TMP("YSCL",$J),^TMP
          ("YSCLL",$J) Q
         Q
END1     ;
         K ^TMP($J),^TMP("YSCL",$J)
         K %,%DT,%H,%T,AGE,C,CNT,D,DA,DFN,DIE,DIK,DIR,DIROUT,DIRUT,DISYS,DOB,DR
         K DRG,DTOUT,DUOUT,I,IOF,J,K,LAB,LABT,PNM,POP,R,RESULTS1,SEX,SSN,VADM,VA
          ERR,VAPA
         K X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,YSACT,YSCL,YSCL1,YSCL2,YSCL28,YS
          CLA,YSCLA1,YSCLAB
         K YSCLAB1,YSCLAB2,YSCLAB3,YSCLAB4,YSCLC,YSCLD,YSCLD0,YSCLD1,YSCLDAT1
         K YSCLDATA,YSCLDEA,YSCLDEMO,YSCLED,YSCLF,YSCLFF,YSCLFRQ,YSCLGL,YSCLGRN,
          YSCLI
         K YSCLID,YSCLIED,YSCLIEN,YSCLIF,YSCLJ,YSCLLAB,YSCLLD,YSCLLDFN,YSCLLDN
         K YSCLLDT,YSCLLK,YSCLLLN,YSCLLN,YSCLLO,YSCLM180,YSCLM28,YSCLM56,YSCLM7,
          YSCLMTCH,YSCLNAME
         K YSCLNO,YSCLNOW,YSCLNST1,YSCLNSTE,YSCLOVR,YSCLP,YSCLPHY,YSCLR,YSCLRES,
          YSCLRET,YSCLRWBC,YSCLRX
         K YSCLRX2,YSCLSAND,YSCLSB1,YSCLSD,YSCLSGS,YSCLSITE,YSCLSN,YSCLSP,YSCLT,
          YSCLTA,YSCLTDT,YSCLTEST
         K YSCLTL,YSCLTPT,YSCLTLS,YSCLTLS1,YSCLTS1,YSCLTST,YSCLTYPE,YSCLWBC,YSCL
          WBCC
         K YSCLWBCT,YSCLX,YSCLZ2,YSDEBUG,YSOFF,YSRACE,YSRC,YSSTOP,YSTEXT,ZTDESC
         K ZTDTH,ZTIO,ZTREQ,ZTRTN,ZTSAVE,ZTSTOP
         Q
ZEOR     ;YSCLTST3

*****   INDEX OF YSCLTST3   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   %            END!,END1+2!
   %DT          FLERR+10*,END1+2!
   %H           END1+2!
   %T           END1+2!
   AGE          END1+2!
   C            END!,END1+2!
   CNT          END1+2!
   D            END!,END1+2!
   DA           TRANSMIT+23*,TEXIST+2*,END!,END1+2!
   DA(1         TEXIST+2*
   DFN          DMG+2*,DMG+3*,DMG+4,GET+2,GET+3,GET+4,GET+5,GET+6,GET+27
                TRANSMIT+23*,END!,END1+2!
   DIE          TRANSMIT+23*,TEXIST+2*,END1+2!
   DIK          END1+2!
   DIR          TLIST+7!,TLIST+9!,TLIST+11!,TEXIST+1!,END1+2!
   DIR("A"      TLIST+7*,TLIST+10*,TLIST+12*
   DIR(0        TLIST+1*,TLIST+7*,TLIST+9*,TLIST+11*,TEXIST+1*
   DIROUT       END1+2!
   DIRUT        END1+2!
   DISYS        END!,END1+2!
   DOB          END1+2!
   DR           TRANSMIT+23*,TEXIST+2*,END!,END1+2!
   DRG          END1+3!
   DT           GET+7,FLERR+12,FLERR+13
   DTOUT        TLIST+7,TLIST+10,TLIST+12,TEXIST+1,END1+3!
   DUOUT        TLIST+7,TLIST+10,TLIST+12,TEXIST+1,END1+3!
   I            END!,END1+3!
   IOF          END1+3!
   J            END1+3!
   K            END1+3!
   LAB          END1+3!
   LABT         END1+3!
   PNM          END1+3!
   POP          END1+3!
   R            END!,END1+3!
   RESULTS1     END1+3!
   SEX          END1+3!
   SSN          END1+3!
   U            TRANSMIT+2
   VADM         END!,END1+3!
   VADM(1       GET+7,GET+21
   VADM(11      GET+10,GET+20,GET+25,GET+28
   VADM(12      GET+12,GET+20,GET+24,GET+28
   VADM(2       GET+7,GET+21
   VADM(3       GET+7
   VADM(5       GET+7,GET+20,GET+22
   VAERR        END!,END1+3!
   VAPA         END!,END1+3!
   VAPA(6       GET+7,GET+20,GET+23
   X            FLERR+10*,END1+4!
   X1           END1+4!
   X2           END1+4!
   XMDUZ        TRANSMIT+7*,TRANSMIT+13*,TRANSMIT+16*,TRANSMIT+18*,FLERR+16*
                END1+4!
   XMSUB        TRANSMIT+7*,TRANSMIT+13*,TRANSMIT+16*,TRANSMIT+18*,FLERR+12*
                END1+4!
   XMTEXT       TRANSMIT+7*,TRANSMIT+13*,TRANSMIT+16*,TRANSMIT+18*,FLERR+16*
                END1+4!
   XMY          TRANSMIT+6!,TRANSMIT+8!,TRANSMIT+9!,TRANSMIT+12!,TRANSMIT+14!
                TRANSMIT+17!,FLERR+1!,FLERR+5!,FLERR+8!,END1+4!
   XMY("G.CLOZAPINE DEBUG" 
                TRANSMIT+12*,TRANSMIT+17*,FLERR+8*
   XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   " 
                TRANSMIT+6*,TRANSMIT+9*,FLERR+5*
   XMY("G.CLOZAPINE ROLL-UP" 
                FLERR+7*
   XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   " 
                FLERR+4*
   XMY("G.PSOCLOZ" 
                TRANSMIT+8*,TRANSMIT+15*
   XMY("G.RUCLDEM" 
                TRANSMIT+12*
   XMY("G.RUCLDEM@FO-DALLAS.MED.DNS   " 
                TRANSMIT+6*
   XMY("S.RUCLDEM@DNS     .MED.DNS   " 
                TRANSMIT+5*
   XMY("S.RUCLDEM@NCCLAB2.AAC.DNS   " 
                TRANSMIT+11*
   XMZ          END1+4!
   Y            TRANSMIT+4,TRANSMIT+10,FLERR+3,FLERR+6,FLERR+10,TLIST+7
                TLIST+10,TLIST+12,TEXIST+1,TEXIST+2*,END!,END1+4!
   YSACT        END1+4!
   YSCL         GET+7*,GET+13*,GET+17*,GET+19,END!,END1+4!
   YSCL1        END!,END1+4!
   YSCL2        END!,END1+4!
   YSCL28       END1+4!
   YSCLA        DMG+3!,TLIST+3*,TLIST+4*,END1+4!
   YSCLA1       END1+4!
   YSCLAB       END1+4!
   YSCLAB1      END1+5!
   YSCLAB2      END1+5!
   YSCLAB3      END1+5!
   YSCLAB4      END1+5!
>> YSCLB        TLIST+4*,TLIST+5*,TLIST+6
   YSCLC        DMG+4*,GET+7,END!,END1+5!
   YSCLD        END1+5!
   YSCLD0       END1+5!
   YSCLD1       END1+5!
   YSCLDAT1     END1+5!
   YSCLDATA     END1+6!
   YSCLDEA      GET+6*,GET+13,END!,END1+6!
   YSCLDEMO     END1+6!
   YSCLED       END1+6!
   YSCLERR      TLIST+13!,TLIST+15,TLIST+17,TLIST+19,TLIST+21
   YSCLF        END1+6!
   YSCLFF       END1+6!
   YSCLFRQ      END1+6!
   YSCLGL       GET+14*,GET+16,END1+6!
   YSCLGRN      END1+6!
   YSCLI        END1+6!
   YSCLID       END1+7!
   YSCLIED      END1+7!
   YSCLIEN      DMG+2*,DMG+3*,DMG+4,END1+7!
   YSCLIF       END1+7!
   YSCLJ        GET+16*,GET+17,END!,END1+7!
   YSCLLAB      END1+7!
   YSCLLD       END1+7!
   YSCLLDFN     END1+7!
   YSCLLDN      END1+7!
   YSCLLDT      END1+8!
   YSCLLK       END1+8!
   YSCLLLN      END1+8!
   YSCLLN       DMG+2*,DMG+5,GET+19*,TRANSMIT+4,TRANSMIT+10,TRANSMIT+18,END!
                END1+8!
   YSCLLO       END1+8!
   YSCLM180     END1+8!
   YSCLM28      END1+8!
   YSCLM56      END1+8!
   YSCLM7       END1+8!
   YSCLMTCH     END1+8!
   YSCLNAME     END!,END1+8!
   YSCLNO       DMG+2*,GET+21,GET+22,GET+23,GET+24,GET+25,GET+26*,GET+29*
                GET+30*,END!,END1+9!
   YSCLNOW      FLERR+10*,FLERR+12,END1+9!
   YSCLNST1     END1+9!
   YSCLNSTE     END1+9!
   YSCLOVR      END1+9!
   YSCLP        GET+6*,GET+13,END!,END1+9!
   YSCLPHY      END1+9!
   YSCLR        END1+9!
   YSCLRES      TLIST+14,TLIST+16,TLIST+18,END1+9!
   YSCLRET      END1+9!
   YSCLRWBC     END1+9!
   YSCLRX       END1+9!
   YSCLRX2      END1+10!
   YSCLSAND     END1+10!
   YSCLSB1      END1+10!
   YSCLSD       END1+10!
   YSCLSGS      END1+10!
   YSCLSITE     FLERR+11*,FLERR+12,FLERR+13,END1+10!
   YSCLSN       END1+10!
   YSCLSP       END1+10!
   YSCLT        END1+10!
   YSCLTA       END1+10!
   YSCLTDT      END1+10!
   YSCLTEST     END1+10!
   YSCLTL       END1+11!
   YSCLTLS      END1+11!
   YSCLTLS1     END1+11!
   YSCLTPT      END1+11!
   YSCLTS1      TLIST+10*,TLIST+16,END1+11!
>> YSCLTS2      TLIST+12*,TLIST+18
   YSCLTST      TLIST+7*,TLIST+8,TLIST+14,TEXIST+2,END1+11!
   YSCLTYPE     END1+11!
   YSCLWBC      END1+11!
   YSCLWBCC     END1+11!
   YSCLWBCT     END1+12!
   YSCLX        END1+12!
   YSCLZ2       END1+12!
   YSDEBUG      DMG+1*,TRANSMIT+2*,TRANSMIT+6,TRANSMIT+7,TRANSMIT+9,TRANSMIT+12
                TRANSMIT+13,TRANSMIT+16,TRANSMIT+17,TRANSMIT+18,FLERR+5,FLERR+8
                FLERR+12,END1+12!
   YSOFF        END1+12!
   YSRACE       GET+9*,GET+10*,GET+11*,GET+12*,GET+13,END1+12!
   YSRC         GET+10*,GET+12*,END1+12!
   YSSTOP       DMG+3*,GET+1*,TRANSMIT+1*,END1+12!
   YSTEXT       END1+12!
   ZTDESC       END1+12!
   ZTDTH        END1+13!
   ZTIO         END1+13!
   ZTREQ        END1+13!
   ZTRTN        END1+13!
   ZTSAVE       END1+13!
   ZTSTOP       END1+13!

Global Variables  ( * Changed  ! Killed)
   ^%ZOSF("PROD"       TRANSMIT+4,TRANSMIT+10,FLERR+3,FLERR+6
   ^%ZOSF("UCI"        TRANSMIT+4,FLERR+3
   ^DPT(               DMG+4
   ^LAB(60             TLIST+5
   ^PS(55              GET+2,GET+3,GET+6
   ^PS(59              GET+14
   ^TMP("YSCL"         DMG+2!,GET+21*,GET+22*,GET+23*,GET+24*,GET+25*,GET+29*
                       GET+30*,TRANSMIT+18*,TRANSMIT+19*,TRANSMIT+20*,FLERR+12*
                       FLERR+13*,FLERR+14*,FLERR+15*,END!,END1+1!
   ^TMP("YSCLL"        DMG+2!,GET+4,GET+5*,GET+27*,TRANSMIT+23,END!
   ^TMP($J             DMG+2!,GET+19*,END!,END1+1!
   ^VA(200             GET+6
   ^YSCL(603.01        DMG+3,DMG+4
   ^YSCL(603.03        DMG+1,TRANSMIT+2,TRANSMIT+7*,TRANSMIT+13*,TRANSMIT+16*
   ^YSCL(603.04        TLIST+1,TLIST+2,TLIST+4,TLIST+8,TEXIST+2

Naked Globals
   ^(           GET+16
   ^(0          GET+16

Cache Objects
   NONE

Marked Items
   NONE

Label References
   END          DMG+5
   GET          DMG+4
   TEXIST       TLIST+8
   TRANSMIT     DMG+5

External References
   ^%DT                FLERR+10
   $$S^%ZTLOAD         DMG+3,GET+1,TRANSMIT+1
   ^DIE                TRANSMIT+23,TEXIST+2
   UPDATE^DIE          TLIST+20
   VAL^DIE             TLIST+14,TLIST+16,TLIST+18
   ^DIR                TLIST+1,TLIST+7,TLIST+10,TLIST+12,TEXIST+1
   ADD^VADPT           GET+7
   DEM^VADPT           GET+7
   $$SITE^VASITE       FLERR+11
   $$NOW^XLFDT         TRANSMIT+7,TRANSMIT+13,TRANSMIT+16
   ^XMD                TRANSMIT+7,TRANSMIT+13,TRANSMIT+16,TRANSMIT+21,FLERR+16
   END^YSCLTST2        FLERR+17

*****   END   *****

   Press return to continue:

YSCLTST5 * *  215 Lines,  12552 Bytes, Checksum: B110033658
                                                  Jun 17, 2016@09:20:58 page 8
              1432 bytes in comments
YSCLTST5 ;HINOI/RSJ-TRANSMISSION FOR REAL-TIME CLOZAPINE ORDERS ;23 March 16
         ;;5.01;MENTAL HEALTH;**122**;Dec 30, 1994;Build 18
         ; Reference to ^DPT supported by IA #10035
         ; Reference to ^PS(55 supported by IA #787
         ; Reference to ^PS(59 supported by IA #783
         ; Reference to ^VA(200 supported by IA #10060
         ; Reference to ^LAB(60 supported by IA #333
         Q
INPSND   ; BUILD INPATIENT CLOZAPINE TRANSMISSION DATA
         N PSJPAT,PSJIOF,YCLSCNTR,PSGTIM S YSCLRET="",PSJPAT=DFN,PSJIOF=IOF,YCLS
          CNTR=0
         S $P(^XTMP("YSCLTRN",0),"^",1)=DT+365,$P(^XTMP("YSCLTRN",0),"^",2)=DT
         S:'$G(^XTMP("YSCLTRN",DT)) ^XTMP("YSCLTRN",DT)=0
         D DMG,DMG1,GETINP,INPCHK
         I YSCLT D LOAD
         ;S YSCLLN=1 D TRANSMIT^YSCLTST2
         S DFN=PSJPAT,IOF=PSJIOF
         K ^TMP("YSCL",$J),^TMP("YSCLL",$J),^TMP($J)
         Q
DMG      ; Called by PSGOETO
         Q:'DFN
         N PSDFN
         S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3),PSDFN=DFN
         K ^TMP($J),^TMP("YSCL",$J) S (YSCLIEN,YSCLLN)=0,YSCLNO=20
         S YSCLIEN=$O(^YSCL(603.01,"C",DFN,YSCLIEN)) Q:'YSCLIEN
         S $P(YSSTOP,",",8)=8 Q:$$S^%ZTLOAD  D:DFN
         . I $D(^DPT(DFN,0)),$D(^YSCL(603.01,YSCLIEN,0)) S YSCLC=$P($G(^YSCL(603
          .01,YSCLIEN,0)),"^",1) D GET
         . I '$G(YSCLDIS) D
         . . I $D(^TMP("YSCLL",$J,DFN)) D
         . . . S $P(^XTMP("YSCLTRN",0),"^",1)=DT+365,$P(^XTMP("YSCLTRN",0),"^",2
          )=DT
         . . . S:'$G(^XTMP("YSCLDEM",DT)) ^XTMP("YSCLDEM",DT)=0
         . . . I '$G(YSCLDIS1) S ^XTMP("YSCLDEM",DT,DFN,0)=0 ;RTW 
         . . . I $G(YSCLDIS1) S ^XTMP("YSCLDIS",DT,DFN,0)=YSCLDIS2 ;RTW
         . . I $G(YSCLDIS1) S ^XTMP("YSCLDIS",DT,DFN,0)=YSCLDIS2 ;RTW
         ;D TRANSMIT^YSCLTST3:YSCLLN  ; Send demographic data realtime.
         S DFN=PSDFN
         Q
DMG1     ; GATHER FACILITY INFORMATION
         S YSCLLN=0,YSCLLLN=3,(X1,YSCLED)=DT,X2=-60 D C^%DTC S YSCLM28=X,X1=$P(Y
          SCLED,"."),X2=-28 D C^%DTC S YSCLM7=X,YSCLED=YSCLED+.5 ;28 TO 60 and 1
          4 to 28 6/15/05
         S X1=$P(YSCLED,"."),X2=-180 D C^%DTC S YSCLM180=X
         S X1=$P(YSCLED,"."),X2=-56 D C^%DTC S YSCLM56=X
         S YSCLIF=+$$SITE^VASITE_","
         D GETS^DIQ(4,YSCLIF,"1.01;1.02;1.03;.02;1.04","I","YSCLFF")
         S $P(YSCLDEMO,"^",1)=YSCLFF(4,YSCLIF,1.01,"I")
         S $P(YSCLDEMO,"^",2)=YSCLFF(4,YSCLIF,1.02,"I")
         S $P(YSCLDEMO,"^",3)=YSCLFF(4,YSCLIF,1.03,"I")
         S $P(YSCLDEMO,"^",4)=$P(^DIC(5,YSCLFF(4,YSCLIF,.02,"I"),0),"^",2)
         S $P(YSCLDEMO,"^",5)=YSCLFF(4,YSCLIF,1.04,"I")
         S $P(YSCLDEMO,"^",6)=""
         K J,YSCLF,YSCLFF,YSCLIF,X
         Q
GET      ; GATHER PATIENT DEMOGRAPHICS
         S $P(YSSTOP,",",9)=9 Q:$$S^%ZTLOAD
         Q:'$D(^PS(55,DFN,"SAND"))  ;Don't try to transmit if no pharmacy record
         Q:$P(^PS(55,DFN,"SAND"),"^",4)  ;Don't retransmit demographics.
         Q:$D(^TMP("YSCLL",$J,DFN))
         S ^TMP("YSCLL",$J,DFN)=1
         S YSCLP=+$P($G(^PS(55,DFN,"SAND")),"^",5),YSCLDEA=$P($G(^VA(200,YSCLP,"
          PS")),"^",2),YSCLP=$P($G(^VA(200,YSCLP,0)),"^")
         D DEM^VADPT,ADD^VADPT S YSCL=YSCLC_"^"_$E($P(VADM(1),",",2))_$E(VADM(1)
          )_"^"_$P(VADM(3),"^")_"^"_$P(VADM(2),"^")_"^"_$P(VADM(5),"^")_"^"_VAPA
          (6)_"^"_DT
         D
          . S YSRACE="*"
          . S YSRC=0 F  S YSRC=$O(VADM(11,YSRC)) Q:'YSRC  S YSRACE=YSRACE_+VADM(
          11,YSRC)_"-"_+VADM(11,YSRC,1)_","
          . S YSRACE=YSRACE_"~"
          . S YSRC=0 F  S YSRC=$O(VADM(12,YSRC)) Q:'YSRC  S YSRACE=YSRACE_+VADM(
          12,YSRC)_"-"_+VADM(12,YSRC,1)_","
         S YSCL=YSCL_"^"_YSRACE_"^"_YSCLP_"^"_YSCLDEA
         S YSCLGL=$S($D(^PS(59)):"^PS",1:"^DIC")
         ;YSCLGL is used to indirectly hold the global reference for file 59. Th
          is is necessary due to changes in the file location. The $select may b
          e expanded to cover future moves. DBIA 273-B
         F YSCLJ=0:0 S YSCLJ=$O(@YSCLGL@(59,YSCLJ)) Q:'YSCLJ  I $D(^(YSCLJ,"SAND
          ")) S YSCLJ=$P(^(0),"^",5) Q
         S YSCL=YSCL_"^"_YSCLJ
         ;registration number^initials^dob^ssn^sex^zip^today^race^physician^dea^
          zip code (hosp)
         S YSCLLN=YSCLLN+1,^TMP($J,YSCLLN,0)=YSCL
         I VADM(5)=""!(VAPA(6)="")!('VADM(11))!('VADM(12)) D  ;RLM RACETEST
          . S ^TMP("YSCL",$J,YSCLNO,0)=$P(VADM(2),"^",1)_"   "_VADM(1)
          . S:VADM(5)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (SE
          X)"
          . S:VAPA(6)="" ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ZI
          P)"
          . S:'VADM(12) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (RAC
          E, NEW FORMAT)"
          . S:'VADM(11) ^TMP("YSCL",$J,YSCLNO,0)=^TMP("YSCL",$J,YSCLNO,0)_" (ETH
          NICITY)"
          . S YSCLNO=YSCLNO+1
          . S ^TMP("YSCLL",$J,DFN)=0 ; leave unmarked pending demographic data
          . I ('VADM(11))!('VADM(12)) D
          . . S ^TMP("YSCL",$J,YSCLNO,0)="NOTE: Race and Ethnicity may be entere
          d if permission is obtained in the informed consent",YSCLNO=YSCLNO+1
          . . S ^TMP("YSCL",$J,YSCLNO,0)="document. See VHA Directive 99-035.",Y
          SCLNO=YSCLNO+1
         ;
         Q
GETINP   ;Inpatient Medications
         Q:$$S^%ZTLOAD
         S YSCL=^DPT(DFN,0),YSCLX=$E($P($P(YSCL,"^"),",",2))_$E(YSCL)_"^"_$P(YSC
          L,"^",9)
         S YSCLPHY="",$P(YSCLX,"^",6)=$P(YSCLDEMO,"^",5),$P(YSCLX,"^",11)=$P($P(
          $G(^YSCL(603.01,YSCLIEN,0)),"^"),"^"),$P(YSCLX,"^",16)=DT
         ;site zip(p6),registration number (p11), today (p16)
         S YSSTRT=$P($G(^PS(55,DFN,5,+PSGORD,2)),"^",2),YSSTOP=$P($G(^PS(55,DFN,
          5,+PSGORD,2)),"^",4)
         S PSJOR=$P($G(^PS(55,DFN,5,+PSGORD,0)),"^",21)
         Q
INPCHK   ;for data to send
         S YSCLT=0,YSCLWBC=0
         S $P(YSSTOP,",",3)=3 Q:$$S^%ZTLOAD
         K PNM,SEX,DOB,AGE,SSN D DEM^VADPT I 'VAERR S PNM=VADM(1),SEX=$P(VADM(5)
          ,U),DOB=$P(VADM(3),U),AGE=VADM(4),SSN=$P(VADM(2),U)
         I PSGSD=0,$P($G(^PS(55,DFN,"SAND")),"^",2)="P" Q  ;no transmit for pret
          reatment
         I PSGSD,PSGSD<YSCLM56 S $P(^PS(55,DFN,"SAND"),"^",2)="D" ;force discont
          inued
         I PSGSD,PSGSD<YSCLM180 Q  ;Don't report if over 6 months old.
         S YSCL=$O(YSCLA("")) I 'YSCL D LAB^YSCLTST1 S YSCLT=1 ;Q  ;get latest W
          BC results even if no script.
         S YSCLT=1,YSCLRX=$G(^PS(55,DFN,5,+PSGORD,0)),YSCLRX2=$G(^PS(55,DFN,5,+P
          SGORD,2)) ;we've got something
         ;YSCLGL is used to indirectly hold the global reference for file 59. Th
          is is necessary due to changes in the file location. The $select may b
          e expanded to cover future moves. DBIA 273-B
         N PSJWRD,PSJDIV,PSJINST
         S PSJWRD=$P(YSCLRX,"^",23) S:'$G(PSJWRD) PSJWRD=$P(YSCLRX2,"^",10)
         S PSJINST=$G(^DIC(42,PSJWRD,44)),PSJDIV=$P(^SC(PSJINST,0),"^",4)
         S YSCLD=PSJDIV,$P(YSCLX,"^",10)=$P(^DIC(4,YSCLD,"DEA"),"^"),$P(YSCLX,"^
          ",12)=YSCLD
         ;site DEA# (p10), site pointer (p12)
         ;here if active
         I $P(^PS(55,DFN,"SAND"),"^",2)="A" S $P(YSCLX,"^",5)="A" ;force active
         S $P(YSCLX,"^",13)=1,$P(YSCLX,"^",9)=PSGLI
         S $P(YSCLX,"^",8)=+$G(^PS(55,DFN,5,+$G(PSGORD),"SAND"))
         ;status(p5),dosage(p8),rx count(p13),issue date(p9)
         S YSCLLO=$O(^PS(53.8,"A",PSJOR,0)) I YSCLLO S YSCLLO=^PS(53.8,YSCLLO,0)
          ,$P(YSCLX,"^",14)=$P(YSCLLO,"^",5) D
         .I $P(YSCLLO,"^",5)=9  D
         ..N YSCLTMP6 S YSCLTMP6=$P(YSCLLO,"^",6)
         ..I YSCLTMP6="Weather Related Conditions" S $P(YSCLX,"^",14)=$P(YSCLX,"
          ^",14)_1
         ..I YSCLTMP6="Mail Order Delay" S $P(YSCLX,"^",14)=$P(YSCLX,"^",14)_2
         ..I YSCLTMP6="Inpatient Going On Leave" S $P(YSCLX,"^",14)=$P(YSCLX,"^"
          ,14)_3
         .S YSCLLO=+$P(YSCLLO,"^",4),$P(YSCLX,"^",15)=$P(^VA(200,YSCLLO,0),"^")
         ;lockout reason (p14), approving official (p15)
         S $P(YSSTOP,",",4)=4 Q:$$S^%ZTLOAD
         S YSCLPHY=$G(^VA(200,+$P(YSCLRX,"^",2),0)),$P(YSCLX,"^",7)=$P($G(^VA(20
          0,+$P(YSCLRX,"^",2),"PS")),"^",2),YSCLPHY=$P(YSCLPHY,"^")
         ; add if prescription on same day for different drug and different dose
         S $P(YSCLX,"^",21)=$P(^PSDRUG(+PSGDN,2),"^",4) ;Add NDC to string
         S YCLSCNTR=YCLSCNTR+1
         I $D(^XTMP("YSCLTRN",DT,DFN,PSGLI)) D
         .S PSGTIM=PSGLI,$P(PSGTIM,".",2)=$P(PSGTIM,".",2)_1
         I $G(PSGTIM) N PSGLI S PSGLI=PSGTIM
         S ^XTMP("YSCLTRN",DT,DFN,PSGLI,0)=0_"^I^"_PSJOR
         S ^XTMP("YSCLTRN",DT,DFN,PSGLI,YCLSCNTR)=YSCLX
         Q
LOAD     ;
         S $P(YSSTOP,",",6)=6 Q:$$S^%ZTLOAD
         I YSCLWBC="",YSCLLD<YSCLM28 Q
         ; don't send for pretest or older that 28 days
         S YSCLNSTE=$P(YSCLX,"^",12)
         S YSCLNST1=$P($$SITE^VASITE,"^",2),YSCLNSTE=$P($$SITE^VASITE,"^",3)
         S YSCLLN=YSCLLN+1,$P(YSCLX,"^",18)=YSCLRET,^TMP($J,YSCLLN,0)=YSCLX,YSCL
          LN=YSCLLN+1,^TMP($J,YSCLLN,0)=YSCLPHY_"^"_YSCLDEMO_"^"_YSCLNSTE_"^"_YS
          CLNST1
         I $D(^TMP($J,YSCLLN,0)) D
         .S YCLSCNTR=YCLSCNTR+1,^XTMP("YSCLTRN",DT,DFN,PSGLI,YCLSCNTR)=^TMP($J,Y
          SCLLN,0)
         ;site number and name
         S YSCLLLN=YSCLLLN+1,^TMP("YSCL",$J,YSCLLLN,0)=$P(^DPT(DFN,0),"^",9)_"  
           "_$P(^(0),"^")_"  (R) "_$S($P(YSCLX,"^",13)="":"NO RX   ",1:$$FMTE^XL
          FDT($P(YSCLX,"^",9),"D"))_" (W) "
         S ^TMP("YSCL",$J,YSCLLLN,0)=^TMP("YSCL",$J,YSCLLLN,0)_$S($P(YSCLX,"^",3
          )="":"NO WBC   ",1:$$FMTE^XLFDT($P(YSCLX,"^",3),"D"))_" (N) "_$S($P(YS
          CLX,"^",20)="":"NO NEUT  ",1:$$FMTE^XLFDT($P(YSCLX,"^",19),"D")) ;Q
         I $D(^TMP("YSCL",$J)) D
         .S YCLSCNTR=YCLSCNTR+1,^XTMP("YSCLTRN",DT,DFN,PSGLI,YCLSCNTR)=$G(^TMP("
          YSCL",$J,YSCLLLN,0))
         ;9the piece for issue date, 16th piece for WBC date ;RLM 06/16/05
         S ^XTMP("YSCLTRN",DT,0)=+$G(^XTMP("YSCLTRN",DT,0))+1
         Q
DOSE     ; GET DOSE
         N YSCLPS55,YSCLPTR,YSCLDFN
         S YSCLPS55=+$G(^OR(100,+PSJOR,4)),PSJDOSE=0
         S YSCLPTR=0 F  S YSCLPTR=$O(^PS(55,DFN,5,YSCLPS55,1,YSCLPTR)) Q:'YSCLPT
          R  D
         .S PSJDOSE=PSJDOSE+($P($G(^PS(55,DFN,5,YSCLPS55,1,YSCLPTR,0)),"^",2)*$P
          (^PS(55,DFN,5,YSCLPS55,.2),"^",5)),YSCLDFN=DFN
         .D FRQ S PSJDOSE=PSJDOSE*PSJFRQ
         Q
FRQ      ; GET ADMIN FREQUENCY
         N PSJDI
         S PSJFRQ(0)=+$$GET1^DIQ(55.06,YSCLPS55_","_YSCLDFN_",",42)
         I 'PSJFRQ(0) D   ;Get administration times
         .S PSJFRQ=+$$GET1^DIQ(55.06,YSCLPS55_","_YSCLDFN_",",41)
         .I $$GET1^DIQ(55.06,YSCLPS55_","_YSCLDFN_",",26)["@" D  ; CHECK FOR @ I
          N DAY OF WEEK SCHEDULE
         .. S PSJFRQ(0)=1440/$L(PSJFRQ,"-") Q                  ; THEN CALCULATE 
          CORRECT FRUENCY
         . Q:+$G(PSJFRQ(0))
         . I '$L($TR(PSJFRQ,"0123456789-")) Q          ; no good - we have non n
          umeric characters
         . F PSJDI=1:1:$L(PSJFRQ,"-") I $P(PSJFRQ,"-",PSJDI)]"" D      ; If we h
          ave data in the piece
         .. I $L($P(PSJFRQ,"-",PSJDI))>2,$L($P(PSJFRQ,"-",PSJDI))<5             
                                      ;
         .. E  S PSJFRQ="" Q                                        ; only allow
           3 or 4 digits
         .. I $L($P(PSJFRQ,"-",PSJDI))=4 D  Q
         ... I $E($P(PSJFRQ,"-",PSJDI),3,4)<60,$E($P(PSJFRQ,"-",PSJDI),1,2)<25 S
           PSJFRQ(0)=1+PSJFRQ(0) Q
         ... S PSJFRQ="" Q                                          ; Out of ran
          ge
         .. I $L($P(PSJFRQ,"-",PSJDI))=3,$E($P(PSJFRQ,"-",PSJDI),2,3)<60 S PSJFR
          Q(0)=1+PSJFRQ(0) Q
         .. S PSJFRQ="" Q                                     ; Out of range
         S PSJFRQ=$$GET1^DIQ(55.06,YSCLPS55_","_YSCLDFN_",",42)
         S:PSJFRQ(0)=0 PSJFRQ(0)=1440
         S PSJFRQ=1440/PSJFRQ(0)
         Q
XMIT     ;
         D START^YSCLDIS ; THIS WILL CHECK FOR CLOZAPINE PATIENTS THAT NEED TO B
          E DISCONTINUED AND DISCONTIUNE THEM & SEND MESSAGE TO NCCC
         N YSCLDT,YSCLTRDT D NOW^%DTC S YSCLDT=%-1
         S YSCLLST=$P($G(^XTMP("YSCLDEM",0)),"^",4),YSCLTRDT=$P(YSCLLST,".",1)
         I $O(^XTMP("YSCLDEM",YSCLTRDT)) D
         .N DFN,PSDFN,VA,VACNTRY,VADM,VAERR,VAPA,XMDUN,XMDUZ,XMZ,Y,YSCL,YSCLDEA,
          YSCLGL,YSCLJ
         .N YSCLLN,YSCLORD,YSCLP,YSCLX,YSRACE,YSRC,YSDEBUG,YSCLIEN,YSSTOP,YSCLC,
          YSCLCNTR,YSCLNO
         .S YSCLTRDT=$O(^XTMP("YSCLDEM",YSCLTRDT)) Q:'YSCLTRDT!(YSCLTRDT=DT)  D
         ..S YSDEBUG=$P(^YSCL(603.03,1,0),"^",3)
         ..K ^TMP($J),^TMP("YSCL",$J),^TMP("YSCLL",$J) S (YSCLIEN,YSCLLN)=0,YSCL
          NO=20
         ..S YSCLCNTR=0
         ..S DFN=0 F  S DFN=$O(^XTMP("YSCLDEM",YSCLTRDT,DFN)) Q:'DFN  D
         ...S YSCLIEN=$O(^YSCL(603.01,"C",DFN,YSCLIEN)) Q:'YSCLIEN
         ...S $P(YSSTOP,",",8)=8 Q:$$S^%ZTLOAD  D:DFN
         ....I $D(^DPT(DFN,0)),$D(^YSCL(603.01,YSCLIEN,0)) S YSCLC=$P($G(^YSCL(6
          03.01,YSCLIEN,0)),"^",1) D GET
         ...S ^XTMP("YSCLDEM",YSCLTRDT,DFN,0)=1,YSCLCNTR=YSCLCNTR+1
         ..D TRANSMIT^YSCLTST3:YSCLLN
         ..S ^XTMP("YSCLDEM",YSCLTRDT)=YSCLCNTR,$P(^XTMP("YSCLDEM",0),"^",4)=YSC
          LDT
         ..K ^TMP("YSCLL",$J)
         .;
         .S YSCLCT=4,YSCLCNTR=1
         .S YSCLTRDT=$P(YSCLLST,".",1)
         .S YSCLTRDT=$P($G(^XTMP("YSCLTRN",0)),"^",4),YSCLTRDT=$P(YSCLTRDT,".",1
          )
         .I $O(^XTMP("YSCLTRN",YSCLTRDT)) D
         ..F  S YSCLTRDT=$O(^XTMP("YSCLTRN",YSCLTRDT)) Q:'YSCLTRDT!(YSCLTRDT=DT)
             D
         ...D ORDBLD
         ...S YSCLLN=$G(^XTMP("YSCLTRN",YSCLTRDT,0)) D TRANSMIT^YSCLTST2
         ...S ^XTMP("YSCLTRN",YSCLTRDT)=1,$P(^XTMP("YSCLTRN",0),"^",4)=YSCLDT
         ...K ^TMP("YSCLL",$J)
         Q
         ;
ORDBLD   ;
         N YSCLDFN,YSCLCNT,YSCLCNTR ;,YSCLCT
         S YSCLCNTR=1,YSCLDFN=0 F  S YSCLDFN=$O(^XTMP("YSCLTRN",YSCLTRDT,YSCLDFN
          )) Q:'YSCLDFN  D
         .S YSCLORD=0 F  S YSCLORD=$O(^XTMP("YSCLTRN",YSCLTRDT,YSCLDFN,YSCLORD))
           Q:'YSCLORD!(YSCLORD>DT)  D
         ..S YSCLCNT=0 F  S YSCLCNT=$O(^XTMP("YSCLTRN",YSCLTRDT,YSCLDFN,YSCLORD,
          YSCLCNT)) Q:'YSCLCNT  D
         ...S:YSCLCNT=1 ^TMP($J,YSCLCNT,0)=$G(^XTMP("YSCLTRN",YSCLTRDT,YSCLDFN,Y
          SCLORD,YSCLCNT)),^TMP($J,YSCLCNTR,0)=$G(^XTMP("YSCLTRN",YSCLTRDT,YSCLD
          FN,YSCLORD,YSCLCNT)),YSCLCNTR=YSCLCNTR+1
         ...S:YSCLCNT=2 ^TMP($J,YSCLCNT,0)=$G(^XTMP("YSCLTRN",YSCLTRDT,YSCLDFN,Y
          SCLORD,YSCLCNT)),^TMP($J,YSCLCNTR,0)=$G(^XTMP("YSCLTRN",YSCLTRDT,YSCLD
          FN,YSCLORD,YSCLCNT)),YSCLCNTR=YSCLCNTR+1
         ...S:YSCLCNT=3 ^TMP("YSCL",$J,YSCLCT,0)=$G(^XTMP("YSCLTRN",YSCLTRDT,YSC
          LDFN,YSCLORD,YSCLCNT)),YSCLCT=YSCLCT+1
         Q

*****   INDEX OF YSCLTST5   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
>> %            XMIT+2
   AGE          INPCHK+3!*
   DFN          INPSND+1,INPSND+7*,DMG+1,DMG+3,DMG+5,DMG+6,DMG+7,DMG+9,DMG+12
                DMG+13,DMG+14,DMG+16*,GET+2,GET+3,GET+4,GET+5,GET+6,GET+27
                GETINP+2,GETINP+5,GETINP+6,INPCHK+4,INPCHK+5,INPCHK+8,INPCHK+16
                INPCHK+18,INPCHK+33,INPCHK+36,INPCHK+37,LOAD+8
                LOAD+10,LOAD+13,DOSE+3,DOSE+4,XMIT+5~,XMIT+11*,XMIT+12,XMIT+13
                XMIT+14,XMIT+15
   DOB          INPCHK+3!*
   DT           INPSND+2,INPSND+3,DMG+10,DMG+11,DMG+12,DMG+13,DMG+14,DMG1+1
                GET+7,GETINP+3,INPCHK+33,INPCHK+36,INPCHK+37,LOAD+8,LOAD+13
                LOAD+15,XMIT+7,XMIT+24,ORDBLD+3
   IOF          INPSND+1,INPSND+7*
   J            DMG1+12!
   PNM          INPCHK+3!*
   PSDFN        DMG+2~,DMG+3*,DMG+16,XMIT+5~
>> PSGDN        INPCHK+31
   PSGLI        INPCHK+17,INPCHK+33,INPCHK+34,INPCHK+35~*,INPCHK+36,INPCHK+37
                LOAD+8,LOAD+13
>> PSGORD       GETINP+5,GETINP+6,INPCHK+8,INPCHK+18
>> PSGSD        INPCHK+4,INPCHK+5,INPCHK+6
   PSGTIM       INPSND+1~,INPCHK+34*,INPCHK+35
   PSJDI        FRQ+1~,FRQ+9*,FRQ+10,FRQ+12,FRQ+13,FRQ+15
   PSJDIV       INPCHK+10~,INPCHK+12*,INPCHK+13
>> PSJDOSE      DOSE+2*,DOSE+4*,DOSE+5*
>> PSJFRQ       DOSE+5,FRQ+4*,FRQ+6,FRQ+8,FRQ+9,FRQ+10,FRQ+11*,FRQ+12,FRQ+13
                FRQ+14*,FRQ+15,FRQ+16*,FRQ+17*,FRQ+19*
>> PSJFRQ(0     FRQ+2*,FRQ+3,FRQ+6*,FRQ+7,FRQ+13*,FRQ+15*,FRQ+18*,FRQ+19
   PSJINST      INPCHK+10~,INPCHK+12*
   PSJIOF       INPSND+1~*,INPSND+7
>> PSJOR        GETINP+6*,INPCHK+20,INPCHK+36,DOSE+2
   PSJPAT       INPSND+1~*,INPSND+7
   PSJWRD       INPCHK+10~,INPCHK+11*,INPCHK+12
   SEX          INPCHK+3!*
   SSN          INPCHK+3!*
   U            INPCHK+3
   VA           XMIT+5~
   VACNTRY      XMIT+5~
   VADM         XMIT+5~
   VADM(1       GET+7,GET+21,INPCHK+3
   VADM(11      GET+10,GET+20,GET+25,GET+28
   VADM(12      GET+12,GET+20,GET+24,GET+28
   VADM(2       GET+7,GET+21,INPCHK+3
   VADM(3       GET+7,INPCHK+3
   VADM(4       INPCHK+3
   VADM(5       GET+7,GET+20,GET+22,INPCHK+3
   VAERR        INPCHK+3,XMIT+5~
   VAPA         XMIT+5~
   VAPA(6       GET+7,GET+20,GET+23
   X            DMG1+1,DMG1+2,DMG1+3,DMG1+12!
>> X1           DMG1+1*,DMG1+2*,DMG1+3*
>> X2           DMG1+1*,DMG1+2*,DMG1+3*
   XMDUN        XMIT+5~
   XMDUZ        XMIT+5~
   XMZ          XMIT+5~
   Y            XMIT+5~
   YCLSCNTR     INPSND+1~*,INPCHK+32*,INPCHK+37,LOAD+8*,LOAD+13*
   YSCL         GET+7*,GET+13*,GET+17*,GET+19,GETINP+2*,INPCHK+7*,XMIT+5~
>> YSCLA(""     INPCHK+7
   YSCLC        DMG+7*,GET+7,XMIT+6~,XMIT+14*
   YSCLCNT      ORDBLD+1~,ORDBLD+4*,ORDBLD+5,ORDBLD+6,ORDBLD+7
   YSCLCNTR     XMIT+6~,XMIT+10*,XMIT+15*,XMIT+17,XMIT+20*,ORDBLD+1~,ORDBLD+2*
                ORDBLD+5*,ORDBLD+6*
>> YSCLCT       XMIT+20*,ORDBLD+7*
>> YSCLD        INPCHK+13*
   YSCLDEA      GET+6*,GET+13,XMIT+5~
>> YSCLDEMO     DMG1+6*,DMG1+7*,DMG1+8*,DMG1+9*,DMG1+10*,DMG1+11*,GETINP+3
                LOAD+6
   YSCLDFN      DOSE+1~,DOSE+4*,FRQ+2,FRQ+4,FRQ+5,FRQ+17,ORDBLD+1~,ORDBLD+2*
                ORDBLD+3,ORDBLD+4,ORDBLD+5,ORDBLD+6,ORDBLD+7
>> YSCLDIS      DMG+8
>> YSCLDIS1     DMG+12,DMG+13,DMG+14
>> YSCLDIS2     DMG+13,DMG+14
   YSCLDT       XMIT+2~*,XMIT+17,XMIT+27
>> YSCLED       DMG1+1*,DMG1+2,DMG1+3
   YSCLF        DMG1+12!
   YSCLFF       DMG1+12!
   YSCLFF(4     DMG1+6,DMG1+7,DMG1+8,DMG1+9,DMG1+10
   YSCLGL       GET+14*,GET+16,XMIT+5~
   YSCLIEN      DMG+4*,DMG+5*,DMG+7,GETINP+3,XMIT+6~,XMIT+9*,XMIT+12*,XMIT+14
   YSCLIF       DMG1+4*,DMG1+5,DMG1+6,DMG1+7,DMG1+8,DMG1+9,DMG1+10,DMG1+12!
   YSCLJ        GET+16*,GET+17,XMIT+5~
>> YSCLLD       LOAD+2
>> YSCLLLN      DMG1+1*,LOAD+10*,LOAD+11,LOAD+13
   YSCLLN       DMG+4*,DMG1+1*,GET+19*,LOAD+6*,LOAD+7,LOAD+8,XMIT+6~,XMIT+9*
                XMIT+16,XMIT+26*
>> YSCLLO       INPCHK+20*,INPCHK+21,INPCHK+22,INPCHK+26*
>> YSCLLST      XMIT+3*,XMIT+21
>> YSCLM180     DMG1+2*,INPCHK+6
>> YSCLM28      DMG1+1*,LOAD+2
>> YSCLM56      DMG1+3*,INPCHK+5
>> YSCLM7       DMG1+1*
   YSCLNO       DMG+4*,GET+21,GET+22,GET+23,GET+24,GET+25,GET+26*,GET+29*
                GET+30*,XMIT+6~,XMIT+9*
>> YSCLNST1     LOAD+5*,LOAD+6
>> YSCLNSTE     LOAD+4*,LOAD+5*,LOAD+6
   YSCLORD      XMIT+6~,ORDBLD+3*,ORDBLD+4,ORDBLD+5,ORDBLD+6,ORDBLD+7
   YSCLP        GET+6*,GET+13,XMIT+6~
>> YSCLPHY      GETINP+3*,INPCHK+29*,LOAD+6
   YSCLPS55     DOSE+1~,DOSE+2*,DOSE+3,DOSE+4,FRQ+2,FRQ+4,FRQ+5,FRQ+17
   YSCLPTR      DOSE+1~,DOSE+3*,DOSE+4
>> YSCLRET      INPSND+1*,LOAD+6
>> YSCLRX       INPCHK+8*,INPCHK+11,INPCHK+29
>> YSCLRX2      INPCHK+8*,INPCHK+11
>> YSCLT        INPSND+5,INPCHK+1*,INPCHK+7*,INPCHK+8*
   YSCLTMP6     INPCHK+22~*,INPCHK+23,INPCHK+24,INPCHK+25
   YSCLTRDT     XMIT+2~,XMIT+3*,XMIT+4,XMIT+7*,XMIT+11,XMIT+15,XMIT+17,XMIT+21*
                XMIT+22*,XMIT+23,XMIT+24*,XMIT+26,XMIT+27,ORDBLD+2,ORDBLD+3
                ORDBLD+4,ORDBLD+5,ORDBLD+6,ORDBLD+7
>> YSCLWBC      INPCHK+1*,LOAD+2
   YSCLX        GETINP+2*,GETINP+3*,INPCHK+13*,INPCHK+16*,INPCHK+17*,INPCHK+18*
                INPCHK+20*,INPCHK+23*,INPCHK+24*,INPCHK+25*,INPCHK+26*
                INPCHK+29*,INPCHK+31*,INPCHK+37,LOAD+4,LOAD+6*,LOAD+10,LOAD+11
                XMIT+6~
   YSDEBUG      DMG+3*,XMIT+6~,XMIT+8*
   YSRACE       GET+9*,GET+10*,GET+11*,GET+12*,GET+13,XMIT+6~
   YSRC         GET+10*,GET+12*,XMIT+6~
   YSSTOP       DMG+6*,GET+1*,GETINP+5*,INPCHK+2*,INPCHK+28*,LOAD+1*,XMIT+6~
                XMIT+13*
>> YSSTRT       GETINP+5*

Global Variables  ( * Changed  ! Killed)
   ^DIC(4              INPCHK+13
   ^DIC(42             INPCHK+12
   ^DIC(5              DMG1+9
   ^DPT(               DMG+7,GETINP+2,LOAD+10,XMIT+14
   ^OR(100             DOSE+2
   ^PS(53.8            INPCHK+20
   ^PS(55              GET+2,GET+3,GET+6,GETINP+5,GETINP+6,INPCHK+4,INPCHK+5*
                       INPCHK+8,INPCHK+16,INPCHK+18,DOSE+3,DOSE+4
   ^PS(59              GET+14
   ^PSDRUG(            INPCHK+31
   ^SC(                INPCHK+12
   ^TMP("YSCL"         INPSND+8!,DMG+4!,GET+21*,GET+22*,GET+23*,GET+24*,GET+25*
                       GET+29*,GET+30*,LOAD+10*,LOAD+11*,LOAD+12,LOAD+13
                       XMIT+9!,ORDBLD+7*
   ^TMP("YSCLL"        INPSND+8!,DMG+9,GET+4,GET+5*,GET+27*,XMIT+9!,XMIT+18!
                       XMIT+28!
   ^TMP($J             INPSND+8!,DMG+4!,GET+19*,LOAD+6*,LOAD+7,LOAD+8,XMIT+9!
                       ORDBLD+5*,ORDBLD+6*
   ^VA(200             GET+6,INPCHK+26,INPCHK+29
   ^XTMP("YSCLDEM"     DMG+11*,DMG+12*,XMIT+3,XMIT+4,XMIT+7,XMIT+11,XMIT+15*
                       XMIT+17*
   ^XTMP("YSCLDIS"     DMG+13*,DMG+14*
   ^XTMP("YSCLTRN"     INPSND+2*,INPSND+3*,DMG+10*,INPCHK+33,INPCHK+36*
                       INPCHK+37*,LOAD+8*,LOAD+13*,LOAD+15*,XMIT+22,XMIT+23
                       XMIT+24,XMIT+26,XMIT+27*,ORDBLD+2,ORDBLD+3,ORDBLD+4
                       ORDBLD+5,ORDBLD+6,ORDBLD+7
   ^YSCL(603.01        DMG+5,DMG+7,GETINP+3,XMIT+12,XMIT+14
   ^YSCL(603.03        DMG+3,XMIT+8

Naked Globals
   ^(           GET+16
   ^(0          GET+16,LOAD+10

Cache Objects
   NONE

Marked Items
   NONE

Label References
   DMG          INPSND+4
   DMG1         INPSND+4
   FRQ          DOSE+5
   GET          DMG+7,XMIT+14
   GETINP       INPSND+4
   INPCHK       INPSND+4
   LOAD         INPSND+5
   ORDBLD       XMIT+25

External References
   C^%DTC              DMG1+1,DMG1+2,DMG1+3
   NOW^%DTC            XMIT+2
   $$S^%ZTLOAD         DMG+6,GET+1,GETINP+1,INPCHK+2,INPCHK+28,LOAD+1,XMIT+13
   $$GET1^DIQ          FRQ+2,FRQ+4,FRQ+5,FRQ+17
   GETS^DIQ            DMG1+5
   ADD^VADPT           GET+7
   DEM^VADPT           GET+7,INPCHK+3
   $$SITE^VASITE       DMG1+4,LOAD+5
   $$FMTE^XLFDT        LOAD+10,LOAD+11
   START^YSCLDIS       XMIT+1
   LAB^YSCLTST1        INPCHK+7
   TRANSMIT^YSCLTST2   XMIT+26
   TRANSMIT^YSCLTST3   XMIT+16

*****   END   *****

   Press return to continue:

YSCLTST6 * *  95 Lines,  5038 Bytes, Checksum: B24801123
                                                  Jun 17, 2016@09:20:58 page 9
              910 bytes in comments
YSCLTST6 ;HINOI/RBN-TRANSMISSION FOR REAL-TIME CLOZAPINE ORDERS (OUTPATIENT ;23 
          March 16
         ;;5.01;MENTAL HEALTH;**122**;Dec 30, 1994;Build 18
         ;
OUTPT    ; Build outpatient clozapine data for transmision
         N PSOPAT,PSOIOF,YSCLCNTR,YSCLDFN
         S YSCLRET=""
         S PSOPAT=DFN
         S PSODFN=DFN
         S PSOIOF=IOF
         S YSCLCNTR=0
         S $P(^XTMP("YSCLTRN",0),"^",1)=DT+365,$P(^XTMP("YSCLTRN",0),"^",2)=DT ;
          _"^CLOZAPINE DAILY ROLLUP DATA"
         S:'$G(^XTMP("YSCLTRN",DT)) ^XTMP("YSCLTRN",DT)=0
         ; Get patient and facility demographic data
         D DMG^YSCLTST5
         D DMG1^YSCLTST5
         D GET^YSCLTST5
         S DFN=PSODFN
         S YSCL1=PSONEW("IRXN")
         S YSCLLD=PSOX("STOP DATE")
         D CHECK
         D LOAD
         ;/RBN - Removed because of change in requirement from real-time to dail
          y (for now).
         ;D TRANSMIT^YSCLTST2  ; Real time transmit the data to NCCC
         S IOF=PSOIOF
         D END
         Q
         ;
CHECK    ;for data to send
         K ^TMP($J),^TMP("YSCL",$J) S YSCLIEN=0
         S YSCLIEN=$O(^YSCL(603.01,"C",DFN,YSCLIEN)),YSCL=^DPT(DFN,0),YSCLX=$E($
          P($P(YSCL,"^"),",",2))_$E(YSCL)_"^"_$P(YSCL,"^",9)
         S YSCLPHY="",$P(YSCLX,"^",6)=$P(YSCLDEMO,"^",5),$P(YSCLX,"^",11)=$P($P(
          $G(^YSCL(603.01,YSCLIEN,0)),"^"),"^"),$P(YSCLX,"^",16)=DT
         S YSCLT=0
         S $P(YSSTOP,",",3)=3 Q:$$S^%ZTLOAD
         S YSCLLD=$P(^PS(55,DFN,"SAND"),U,6) ;/RBN ADDED 04/12/2016
         K PNM,SEX,DOB,AGE,SSN D DEM^VADPT I 'VAERR S PNM=VADM(1),SEX=$P(VADM(5)
          ,U),DOB=$P(VADM(3),U),AGE=VADM(4),SSN=$P(VADM(2),U)
         I YSCLLD=0,$P($G(^PS(55,DFN,"SAND")),"^",2)="P" Q  ;no transmit for pre
          treatment
         I YSCLLD,YSCLLD<YSCLM56 S $P(^PS(55,DFN,"SAND"),"^",2)="D" ;force disco
          ntinued
         I YSCLLD,YSCLLD<YSCLM180 Q  ;Don't report if over 6 months old.
         S YSCLT=1,YSCLRX=$G(^PSRX(YSCL1,0)),YSCLRX2=$G(^PSRX(YSCL1,2)) ;we've g
          ot something
         S YSCL=$O(YSCLA("")) I 'YSCL D LAB S YSCLT=1 ;Q  ;get latest WBC result
          s even if no script.
         S YSCLGL=$S($D(^PS(59)):"^PS",1:"^DIC")
         ;YSCLGL is used to indirectly hold the global reference for file 59. Th
          is is necessary due to changes in the file location. The $select may b
          e expanded to cover future moves. DBIA 273-B
         S YSCLD=+$P($G(^PSRX(YSCL1,2)),"^",9),YSCLD=$G(@YSCLGL@(59,YSCLD,"SAND"
          )),$P(YSCLX,"^",10)=$P(YSCLD,"^"),$P(YSCLX,"^",12)=$P(YSCLD,"^",2)
         ;site DEA# (p10), site pointer (p12)
         ;here if active
         S $P(^PS(55,DFN,"SAND"),"^",2)="A",$P(YSCLX,"^",5)="A" ;force active
         S $P(YSCLX,"^",13)=1,$P(YSCLX,"^",9)=$P(YSCLRX,"^",13),YSCLD1=$G(^PSRX(
          YSCL1,"SAND")),$P(YSCLX,"^",8)=+YSCLD1
         ;status(p5),dosage(p8),rx count(p13),issue date(p9)
         S YSCLLO=$O(^PS(52.52,"A",YSCL1,0)) I YSCLLO S YSCLLO=^PS(52.52,YSCLLO,
          0),$P(YSCLX,"^",14)=$P(YSCLLO,"^",5),YSCLLO=+$P(YSCLLO,"^",4),$P(YSCLX
          ,"^",15)=$P(^VA(200,YSCLLO,0),"^")
         ;lockout reason (p14), approving official (p15)
         S $P(YSSTOP,",",4)=4 Q:$$S^%ZTLOAD
         S YSCLPHY=$G(^VA(200,+$P(YSCLRX,"^",4),0)),$P(YSCLX,"^",7)=$P($G(^VA(20
          0,+$P(YSCLRX,"^",4),"PS")),"^",2),YSCLPHY=$P(YSCLPHY,"^")
         S $P(YSCLX,"^",4)=$P(YSCLD1,"^",2),$P(YSCLX,"^",3)=$P(YSCLD1,"^",3) I $
          P(YSCLD1,"^",2)]"",$P(YSCLD1,"^",3)'>YSCLED,$P(YSCLD1,"^",3)'<YSCLM7 S
           YSCLWBC=1
         ;wbc(p4),date(p3)
         ; add if prescription on same day for different drug and different dose
         S $P(YSCLX,"^",21)=$P(YSCLRX2,"^",7) ;Add NDC to string
         S ^XTMP("YSCLTRN",DT,DFN,PSOX("LOGIN DATE"),YSCLCNTR)=0
         S YSCLCNTR=YSCLCNTR+1
         S ^XTMP("YSCLTRN",DT,DFN,PSOX("LOGIN DATE"),YSCLCNTR)=YSCLX
         Q
         ;
LAB      ;get most recent
         S $P(YSSTOP,",",5)=5 Q:$$S^%ZTLOAD
         S YSCLLDT="",J=9999998-YSCLED,K=9999998-YSCLM7 I $P(YSCLX,"^",9) S J=99
          99998-$P(YSCLX,"^",9)
         S YSCLR=$$CL^YSCLTST2(DFN) D  ;Set 3,4,17,19,20,22,23
          . S $P(YSCLX,"^",3)=$P(YSCLR,"^",6) ;WBC Date
          . S $P(YSCLX,"^",4)=$P(YSCLR,"^",2) ;WBC Results
          . S $P(YSCLX,"^",19)=$P(YSCLR,"^",6) ;ANC Date
          . S $P(YSCLX,"^",20)=$P(YSCLR,"^",4) ;ANC Results
          . S $P(YSCLX,"^",22)=$P(YSCLR,"^",3) ;WBC Name
          . S $P(YSCLX,"^",23)=$P(YSCLR,"^",5) ;ANC Name
         Q
         ;
LOAD     ;
         S $P(YSSTOP,",",6)=6 Q:$$S^%ZTLOAD
         ; don't send for pretest or older that 28 days
         S YSCLNSTE=$P($G(^PS(59,+$P($G(^PSRX(YSCL1,2)),"^",9),0)),"^",6)
         S YSCLNST1=$P($$SITE^VASITE,"^",2),YSCLNSTE=$P($$SITE^VASITE,"^",3)
         S YSCLLN=YSCLLN+1,$P(YSCLX,"^",18)=YSCLRET,^TMP($J,YSCLLN,0)=YSCLX,YSCL
          LN=YSCLLN+1,^TMP($J,YSCLLN,0)=YSCLPHY_"^"_YSCLDEMO_"^"_YSCLNSTE_"^"_YS
          CLNST1
         S YSCLCNTR=YSCLCNTR+1
         S ^XTMP("YSCLTRN",DT,DFN,PSOX("LOGIN DATE"),YSCLCNTR)=^TMP($J,YSCLLN,0)
         ;site number and name
         S YSCLLLN=YSCLLLN+1,^TMP("YSCL",$J,YSCLLLN,0)=$P(^DPT(DFN,0),"^",9)_"  
           "_$P(^(0),"^")_"  (R) "_$S($P(YSCLX,"^",13)="":"NO RX   ",1:$$FMTE^XL
          FDT($P(YSCLX,"^",9),"D"))_" (W) "
         S ^TMP("YSCL",$J,YSCLLLN,0)=^TMP("YSCL",$J,YSCLLLN,0)_$S($P(YSCLX,"^",3
          )="":"NO WBC   ",1:$$FMTE^XLFDT($P(YSCLX,"^",3),"D"))_" (N) "_$S($P(YS
          CLX,"^",20)="":"NO NEUT  ",1:$$FMTE^XLFDT($P(YSCLX,"^",19),"D"))
         S YSCLCNTR=YSCLCNTR+1
         S ^XTMP("YSCLTRN",DT,DFN,PSOX("LOGIN DATE"),YSCLCNTR)=^TMP("YSCL",$J,YS
          CLLLN,0)
         ; Increment the counter for the date and the given patient
         S YSCLCNTR=YSCLCNTR+1
         S ^XTMP("YSCLTRN",DT,0)=+$G(^XTMP("YSCLTRN",DT,0))+1
         Q
         ;
END      ; Clean up
         K ^TMP("YSCL"),^TMP("YSCLL")
         Q
         ;

*****   INDEX OF YSCLTST6   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   AGE          CHECK+7!*
>> DFN          OUTPT+3,OUTPT+4,OUTPT+13*,CHECK+2,CHECK+6,CHECK+8,CHECK+9
                CHECK+18,CHECK+29,CHECK+31,LAB+3,LOAD+7,LOAD+9,LOAD+12
   DOB          CHECK+7!*
   DT           OUTPT+7,OUTPT+8,CHECK+3,CHECK+29,CHECK+31,LOAD+7,LOAD+12
                LOAD+15
   IOF          OUTPT+5,OUTPT+20*
>> J            LAB+2*
>> K            LAB+2*
   PNM          CHECK+7!*
>> PSODFN       OUTPT+4*,OUTPT+13
   PSOIOF       OUTPT+1~,OUTPT+5*,OUTPT+20
>> PSONEW("IRXN" 
                OUTPT+14
   PSOPAT       OUTPT+1~,OUTPT+3*
>> PSOX("LOGIN DATE" 
                CHECK+29,CHECK+31,LOAD+7,LOAD+12
>> PSOX("STOP DATE" 
                OUTPT+15
   SEX          CHECK+7!*
   SSN          CHECK+7!*
   U            CHECK+6,CHECK+7
>> VADM(1       CHECK+7
>> VADM(2       CHECK+7
>> VADM(3       CHECK+7
>> VADM(4       CHECK+7
>> VADM(5       CHECK+7
>> VAERR        CHECK+7
>> YSCL         CHECK+2*,CHECK+12*
>> YSCL1        OUTPT+14*,CHECK+11,CHECK+15,CHECK+19,CHECK+21,LOAD+3
>> YSCLA(""     CHECK+12
   YSCLCNTR     OUTPT+1~,OUTPT+6*,CHECK+29,CHECK+30*,CHECK+31,LOAD+6*,LOAD+7
                LOAD+11*,LOAD+12,LOAD+14*
>> YSCLD        CHECK+15*
>> YSCLD1       CHECK+19*,CHECK+25
>> YSCLDEMO     CHECK+3,LOAD+5
   YSCLDFN      OUTPT+1~
>> YSCLED       CHECK+25,LAB+2
>> YSCLGL       CHECK+13*,CHECK+15
>> YSCLIEN      CHECK+1*,CHECK+2*,CHECK+3
>> YSCLLD       OUTPT+15*,CHECK+6*,CHECK+8,CHECK+9,CHECK+10
>> YSCLLDT      LAB+2*
>> YSCLLLN      LOAD+9*,LOAD+10,LOAD+12
>> YSCLLN       LOAD+5*,LOAD+7
>> YSCLLO       CHECK+21*
>> YSCLM180     CHECK+10
>> YSCLM56      CHECK+9
>> YSCLM7       CHECK+25,LAB+2
>> YSCLNST1     LOAD+4*,LOAD+5
>> YSCLNSTE     LOAD+3*,LOAD+4*,LOAD+5
>> YSCLPHY      CHECK+3*,CHECK+24*,LOAD+5
>> YSCLR        LAB+3*,LAB+4,LAB+5,LAB+6,LAB+7,LAB+8,LAB+9
>> YSCLRET      OUTPT+2*,LOAD+5
>> YSCLRX       CHECK+11*,CHECK+19,CHECK+24
>> YSCLRX2      CHECK+11*,CHECK+28
>> YSCLT        CHECK+4*,CHECK+11*,CHECK+12*
>> YSCLWBC      CHECK+25*
>> YSCLX        CHECK+2*,CHECK+3*,CHECK+15*,CHECK+18*,CHECK+19*,CHECK+21*
                CHECK+24*,CHECK+25*,CHECK+28*,CHECK+31,LAB+2,LAB+4*,LAB+5*
                LAB+6*,LAB+7*,LAB+8*,LAB+9*,LOAD+5*,LOAD+9,LOAD+10
>> YSSTOP       CHECK+5*,CHECK+23*,LAB+1*,LOAD+1*

Global Variables  ( * Changed  ! Killed)
   ^DPT(               CHECK+2,LOAD+9
   ^PS(52.52           CHECK+21
   ^PS(55              CHECK+6,CHECK+8,CHECK+9*,CHECK+18*
   ^PS(59              CHECK+13,LOAD+3
   ^PSRX(              CHECK+11,CHECK+15,CHECK+19,LOAD+3
   ^TMP("YSCL"         CHECK+1!,LOAD+9*,LOAD+10*,LOAD+12,END+1!
   ^TMP("YSCLL"        END+1!
   ^TMP($J             CHECK+1!,LOAD+5*,LOAD+7
   ^VA(200             CHECK+21,CHECK+24
   ^XTMP("YSCLTRN"     OUTPT+7*,OUTPT+8*,CHECK+29*,CHECK+31*,LOAD+7*,LOAD+12*
                       LOAD+15*
   ^YSCL(603.01        CHECK+2,CHECK+3

Naked Globals
   ^(0          LOAD+9

Cache Objects
   NONE

Marked Items
   NONE

Label References
   CHECK        OUTPT+16
   END          OUTPT+21
   LAB          CHECK+12
   LOAD         OUTPT+17

External References
   $$S^%ZTLOAD         CHECK+5,CHECK+23,LAB+1,LOAD+1
   DEM^VADPT           CHECK+7
   $$SITE^VASITE       LOAD+4
   $$FMTE^XLFDT        LOAD+9,LOAD+10
   $$CL^YSCLTST2       LAB+3
   DMG^YSCLTST5        OUTPT+10
   DMG1^YSCLTST5       OUTPT+11
   GET^YSCLTST5        OUTPT+12

*****   END   *****

   Press return to continue:

|opt     * *  7 Lines,  175 Bytes, Checksum:      Jun 17, 2016@09:20:58 page 10
              117 bytes in comments
|opt     ; 'Build file' Options.
         ;
2921764  ; YSCL DAILY TRANSMISSION - Daily Clozapine Transmission (run routine)
         ; ENTRY ACTION
         D XMIT^YSCLTST5
         ; ROUTINE
         D ^YSCLTST5

*****   INDEX OF |opt   *****


Local Variables      Line Occurrences   ( >> not killed explicitly)
                                        ( * Changed  ! Killed  ~ Newed)
   NONE

Global Variables  ( * Changed  ! Killed)
   NONE

Naked Globals
   NONE

Cache Objects
   NONE

Marked Items
   NONE

Label References
   NONE

External References
   ^YSCLTST5           2921764+4
   XMIT^YSCLTST5       2921764+2

*****   END   *****


--- CROSS-REFERENCING ALL ROUTINES ---
   Press return to continue:

*****   Cross Reference of all Routines   *****   Jun 17, 2016@09:20:58 page 11

Local Variables    Routines   ( >> not killed explicitly)
                              ( * Changed  ! Killed  ~ Newed)
   %            YSCLSERV!,YSCLTST3!,YSCLTST5
   %DT          YSCLSERV*!,YSCLSRV1!,YSCLTST2*!,YSCLTST3*!
   %DT("A"      YSCLTST2*
   %DT(0        YSCLTST2*
   %H           YSCLSERV*!,YSCLTST2,YSCLTST3!
   %T           YSCLTST3!
   AGE          YSCLTST3!,YSCLTST5*!,YSCLTST6*!
>> ANQRE        YSCLTST2*
   C            YSCLTST3!
   CNT          YSCLTST2*!,YSCLTST3!
   D            YSCLSERV*!,YSCLTST3!
   DA           YSCL122P*!,YSCLDIS*!,YSCLSERV!,YSCLTST3*!
   DA(1         YSCLTST3*
   DAYS         YSCLTST2~
   DD           YSCLSERV!
   DFN          YSCL122P*!,YSCLDIS*!,YSCLTST2~,YSCLTST3*!,YSCLTST5*,YSCLTST5*~
                YSCLTST6*
   DIC          YSCLSERV*!
   DIC("DR"     YSCLSERV*
   DIC(0        YSCLSERV*
   DIE          YSCL122P*~,YSCLDIS*~,YSCLSERV!,YSCLTST3*!
   DIK          YSCLSERV!,YSCLTST3!
   DIR          YSCLTST2!,YSCLTST3!
   DIR("A"      YSCLTST2*,YSCLTST3*
   DIR(0        YSCLTST2*,YSCLTST3*
   DIROUT       YSCLTST2,YSCLTST3!
   DIRUT        YSCLTST2,YSCLTST3!
   DISYS        YSCLTST3!
   DO           YSCLSERV!
   DOB          YSCLTST3!,YSCLTST5*!,YSCLTST6*!
   DR           YSCL122P*~,YSCLDIS*~,YSCLTST3*!
   DRG          YSCLTST2~,YSCLTST3!
   DT           YSCL122P,YSCLDIS,YSCLTST2,YSCLTST3,YSCLTST5,YSCLTST6
   DTOUT        YSCLTST2,YSCLTST3!
   DUOUT        YSCLTST2,YSCLTST3!
   FDA          YSCLTST2!
   I            YSCLTST2*!,YSCLTST3!
   IOF          YSCLTST2,YSCLTST3!,YSCLTST5*,YSCLTST6*
   J            YSCLTST3!,YSCLTST5!,YSCLTST6*
   K            YSCLTST3!,YSCLTST6*
   LAB          YSCLTST2!,YSCLTST3!
   LAB(         YSCLTST2*
   LAB("BAD TEST" 
                YSCLTST2*
   LAB("NOT"    YSCLTST2*
   LABT         YSCLTST2*!,YSCLTST3!
   PNM          YSCLTST3!,YSCLTST5*!,YSCLTST6*!
   POP          YSCLTST3!
>> PSCLOZ       YSCLSERV
   PSDFN        YSCLTST5*~
>> PSGDN        YSCLTST5
   PSGLI        YSCLTST5*~
>> PSGORD       YSCLTST5
>> PSGSD        YSCLTST5
   PSGTIM       YSCLTST5*~
>> PSJCNT       YSCLTST2*
   PSJDI        YSCLTST5*~
   PSJDIV       YSCLTST5*~
>> PSJDOSE      YSCLTST5*
>> PSJFRQ       YSCLTST5*
>> PSJFRQ(0     YSCLTST5*
   PSJINST      YSCLTST5*~
   PSJIOF       YSCLTST5*~
>> PSJOR        YSCLTST5*
   PSJPAT       YSCLTST5*~
   PSJWRD       YSCLTST5*~
>> PSODFN       YSCLTST6*
   PSOIOF       YSCLTST6*~
   PSOLAST4     YSCLDIS*!
>> PSONEW("IRXN" 
                YSCLTST6
   PSOPAT       YSCLTST6*~
>> PSOX("LOGIN DATE" 
                YSCLTST6
>> PSOX("STOP DATE" 
                YSCLTST6
   R            YSCLTST3!
   RESULTS      YSCLTST2!~
   RESULTS(     YSCLTST2*
   RESULTS1     YSCLTST2*!,YSCLTST3!
   RET          YSCLSERV!
   SEX          YSCLTST3!,YSCLTST5*!,YSCLTST6*!
   SSN          YSCLSERV,YSCLTST3!,YSCLTST5*!,YSCLTST6*!
   U            YSCLTST2,YSCLTST3,YSCLTST5,YSCLTST6
   VA           YSCLTST5~
   VACNTRY      YSCLTST5~
   VADM         YSCLTST3!,YSCLTST5~
   VADM(1       YSCLTST3,YSCLTST5,YSCLTST6
   VADM(11      YSCLTST3,YSCLTST5
   VADM(12      YSCLTST3,YSCLTST5
   VADM(2       YSCLTST3,YSCLTST5,YSCLTST6
   VADM(3       YSCLTST3,YSCLTST5,YSCLTST6
   VADM(4       YSCLTST5,YSCLTST6
   VADM(5       YSCLTST3,YSCLTST5,YSCLTST6
   VAERR        YSCLTST3!,YSCLTST5~,YSCLTST6
   VAPA         YSCLTST3!,YSCLTST5~
   VAPA(6       YSCLTST3,YSCLTST5
   X            YSCL122P!,YSCLDIS!,YSCLSERV*!,YSCLSRV1*!,YSCLTST2*!,YSCLTST3*!
                YSCLTST5!
   X1           YSCL122P*!,YSCLDIS*!,YSCLTST2*!,YSCLTST3!,YSCLTST5*
   X2           YSCL122P*!,YSCLDIS*!,YSCLTST2*!,YSCLTST3!,YSCLTST5*
   XMDUN        YSCLSERV*!,YSCLTST5~
   XMDUZ        YSCL122P*!,YSCLDIS*!,YSCLSERV*!,YSCLSRV1*!,YSCLTST2*,YSCLTST3*!
                YSCLTST5~
   XMER         YSCLSERV!
   XMFROM       YSCLSERV!
   XMREC        YSCLSERV!
   XMRG         YSCLSERV*!,YSCLSERV
   XMSUB        YSCL122P*!,YSCLDIS*!,YSCLSERV*!,YSCLSRV1*!,YSCLTST2*,YSCLTST3*!
   XMTEXT       YSCL122P*!,YSCLDIS*!,YSCLSERV*!,YSCLSRV1*!,YSCLTST2*,YSCLTST3*!
   XMY          YSCLDIS*!,YSCLSERV!,YSCLSRV1!,YSCLTST2!,YSCLTST3!
   XMY("G.CLOZAPINE DEBUG" 
                YSCLSERV*,YSCLSRV1*,YSCLTST2*,YSCLTST3*
   XMY("G.CLOZAPINE DEBUG@FO-DALLAS.MED.DNS   " 
                YSCLSERV*,YSCLSRV1*,YSCLTST2*,YSCLTST3*
   XMY("G.CLOZAPINE ROLL-UP" 
                YSCLDIS*,YSCLSERV*,YSCLSRV1*,YSCLTST2*,YSCLTST3*
   XMY("G.CLOZAPINE ROLL-UP@FORUM.DNS   " 
                YSCLSERV*,YSCLSRV1*,YSCLTST2*,YSCLTST3*
   XMY("G.PSOCLOZ" 
                YSCLTST2*,YSCLTST3*
   XMY("G.RUCLDEM" 
                YSCLTST3*
   XMY("G.RUCLDEM@FO-DALLAS.MED.DNS   " 
                YSCLTST3*
   XMY("G.RUCLRXLAB@FO-DALLAS.MED.DNS   " 
                YSCLTST2*
   XMY("S.RUCLDEM@DNS     .MED.DNS   " 
                YSCLTST3*
   XMY("S.RUCLDEM@NCCLAB2.AAC.DNS   " 
                YSCLTST3*
   XMY("S.RUCLRXLAB@DNS     .MED.DNS   " 
                YSCLTST2*
   XMY("S.RUCLRXLAB@NCCLAB2.AAC.DNS   " 
                YSCLTST2*
   XMZ          YSCLSERV!,YSCLTST2!,YSCLTST3!,YSCLTST5~
   XQDATE       YSCLSERV!,YSCLSRV1
   XQSUB        YSCLSERV!
   Y            YSCLDIS!,YSCLSERV*!,YSCLSRV1!,YSCLTST2!,YSCLTST3*!,YSCLTST5~
   Y15          YSCLTST2!
   YCLSCNTR     YSCLTST5*~
   YSA          YSCLSERV!,YSCLSRV1*!
   YSACT        YSCLTST3!
   YSACTION     YSCLSERV*!
   YSCL         YSCLTST3*!,YSCLTST5*~,YSCLTST6*
   YSCL1        YSCLTST3!,YSCLTST6*
   YSCL2        YSCLTST3!
   YSCL28       YSCLSERV!,YSCLTST3!
   YSCLA        YSCLSERV*!,YSCLTST2*!,YSCLTST3*!
   YSCLA(""     YSCLTST5,YSCLTST6
   YSCLA1       YSCLTST2*!,YSCLTST3!
   YSCLAA       YSCLSERV!
   YSCLAB       YSCLTST3!
   YSCLAB1      YSCLTST3!
   YSCLAB2      YSCLTST3!
   YSCLAB3      YSCLTST3!
   YSCLAB4      YSCLTST3!
   YSCLB        YSCLSERV!,YSCLTST3*
   YSCLC        YSCLSERV!,YSCLTST3*!,YSCLTST5*~
   YSCLCNT      YSCL122P*!,YSCLDIS*!,YSCLDIS*,YSCLDIS*,YSCLTST5*~
   YSCLCNTR     YSCLTST5*~,YSCLTST6*~
>> YSCLCT       YSCLTST5*
   YSCLD        YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLD0       YSCLTST3!
   YSCLD1       YSCLDIS*!,YSCLTST3!,YSCLTST6*
   YSCLD11      YSCLDIS*!
   YSCLD111     YSCLDIS*!
   YSCLD2       YSCLDIS*!
   YSCLD22      YSCLDIS*!
   YSCLD222     YSCLDIS*!
   YSCLD3       YSCLDIS*!
   YSCLD33      YSCLDIS*!
   YSCLD333     YSCLDIS*!
   YSCLD4       YSCL122P*!,YSCLDIS!
   YSCLD44      YSCL122P*!,YSCLDIS!
   YSCLD444     YSCL122P*!,YSCLDIS!
   YSCLDA       YSCLSERV*!
   YSCLDA1      YSCLSERV*!
   YSCLDAT1     YSCLTST3!
   YSCLDATA     YSCL122P*~,YSCLDIS*~,YSCLSERV!,YSCLTST3!
   YSCLDATE     YSCLDIS*!
   YSCLDEA      YSCLTST3*!,YSCLTST5*~
   YSCLDEA1     YSCLSERV!
   YSCLDEMO     YSCLTST3!,YSCLTST5*,YSCLTST6
   YSCLDFN      YSCLDIS*!,YSCLSERV*!,YSCLTST5*~,YSCLTST6~
>> YSCLDIS      YSCLTST5
   YSCLDIS1     YSCL122P*!,YSCLDIS*!,YSCLTST5
   YSCLDIS2     YSCL122P*!,YSCLDIS*!,YSCLTST5
   YSCLDM       YSCLSERV!
   YSCLDOC      YSCLSERV!
   YSCLDOM      YSCLSERV!
   YSCLDR       YSCLSERV!
   YSCLDRA      YSCLSERV!
   YSCLDRB      YSCLSERV!
   YSCLDRG      YSCL122P*~,YSCLDIS*~
   YSCLDT       YSCLTST5*~
   YSCLDTA      YSCLSERV!
   YSCLDUZ      YSCLSERV!
   YSCLED       YSCLSERV*!,YSCLTST2*,YSCLTST3!,YSCLTST5*,YSCLTST6
   YSCLER       YSCLSERV*!,YSCLSERV*
   YSCLERR      YSCLSERV!,YSCLTST3!
   YSCLF        YSCLTST3!,YSCLTST5!
   YSCLFDA      YSCLSERV!
   YSCLFF       YSCLTST3!,YSCLTST5!
   YSCLFF(4     YSCLTST5
   YSCLFLAG     YSCL122P*!,YSCLDIS*!
   YSCLFLDA     YSCL122P!,YSCLDIS*!
   YSCLFLDT     YSCL122P!,YSCLDIS*!
   YSCLFRQ      YSCLSERV!,YSCLTST2*~,YSCLTST3!
   YSCLGL       YSCLTST3*!,YSCLTST5*~,YSCLTST6*
   YSCLGRN      YSCLTST2*!,YSCLTST3!
   YSCLI        YSCLTST3!
   YSCLID       YSCLTST3!
   YSCLIED      YSCLTST3!
   YSCLIEN      YSCLTST3*!,YSCLTST5*~,YSCLTST6*
   YSCLIF       YSCLTST3!,YSCLTST5*!
   YSCLIPT      YSCL122P*~,YSCLDIS*~
   YSCLJ        YSCLTST3*!,YSCLTST5*~
   YSCLLAB      YSCLTST3!
   YSCLLD       YSCLTST3!,YSCLTST5,YSCLTST6*
   YSCLLDFN     YSCLTST3!
   YSCLLDN      YSCLTST3!
   YSCLLDT      YSCLTST3!,YSCLTST6*
   YSCLLK       YSCLTST3!
   YSCLLLN      YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLLN       YSCL122P!,YSCLDIS*!,YSCLSERV,YSCLTST2,YSCLTST3*!,YSCLTST5*~
                YSCLTST6*
   YSCLLNT      YSCLSERV*!
   YSCLLO       YSCLTST3!,YSCLTST5*,YSCLTST6*
>> YSCLLST      YSCLTST5*
   YSCLM180     YSCLTST3!,YSCLTST5*,YSCLTST6
   YSCLM28      YSCLTST3!,YSCLTST5*
   YSCLM56      YSCLTST3!,YSCLTST5*,YSCLTST6
   YSCLM7       YSCLTST3!,YSCLTST5*,YSCLTST6
   YSCLMESG     YSCLDIS*!
   YSCLMTCH     YSCLTST2*!,YSCLTST3!
   YSCLMULT     YSCLTST2*!
   YSCLNAME     YSCLTST3!
   YSCLNM       YSCLSERV*!
   YSCLNO       YSCLTST3*!,YSCLTST5*~
   YSCLNOW      YSCLTST2*,YSCLTST3*!
   YSCLNST1     YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLNSTE     YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLOPT      YSCL122P*~,YSCLDIS*~
   YSCLORD      YSCLTST5*~
   YSCLOVR      YSCLSERV!,YSCLTST2*,YSCLTST3!
   YSCLP        YSCLTST3*!,YSCLTST5*~
   YSCLPHY      YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLPS55     YSCLTST5*~
   YSCLPSDA     YSCL122P*!,YSCLDIS*!
   YSCLPSDT     YSCL122P*~,YSCLDIS*~
   YSCLPT       YSCLSERV*!
   YSCLPTR      YSCLTST5*~
   YSCLR        YSCLTST3!,YSCLTST6*
   YSCLRANC     YSCLTST2*~
   YSCLRANC(    YSCLTST2*
   YSCLREGA     YSCL122P*!,YSCLDIS*!
   YSCLREGD     YSCL122P*!,YSCLDIS*!
   YSCLREGDA    YSCL122P!,YSCLDIS!
   YSCLREGN     YSCL122P!,YSCLDIS*!
   YSCLRES      YSCLTST3!
   YSCLRET      YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLRPT      YSCLSERV!
   YSCLRWBC     YSCLTST2*~,YSCLTST3!
   YSCLRWBC(    YSCLTST2*
   YSCLRX       YSCL122P*~,YSCLDIS*~,YSCLSERV!,YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLRX0      YSCL122P*~,YSCLDIS*~
   YSCLRX2      YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLSAND     YSCLSERV!,YSCLTST3!
   YSCLSB1      YSCLTST2*!,YSCLTST3!
   YSCLSD       YSCLTST2*!,YSCLTST3!
   YSCLSD1      YSCLSERV!
   YSCLSDT      YSCLSERV*!
   YSCLSGS      YSCLTST2*!,YSCLTST3!
   YSCLSITE     YSCLSERV!,YSCLTST2*,YSCLTST3*!
   YSCLSN       YSCLTST3!
   YSCLSP       YSCLTST3!
   YSCLSPDA     YSCL122P*!,YSCLDIS*!
   YSCLSPDT     YSCL122P*~,YSCLDIS*~
   YSCLSSN      YSCLSERV*!
   YSCLST       YSCLSERV*!,YSCLSRV1!
   YSCLSTN      YSCLSERV*!
   YSCLSUB      YSCLSERV*!
   YSCLT        YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLTA       YSCLTST2*!,YSCLTST3!
   YSCLTC       YSCLSERV!
   YSCLTDT      YSCLTST2*,YSCLTST3!
   YSCLTEST     YSCLTST3!
   YSCLTL       YSCLTST2*!,YSCLTST3!
   YSCLTLS      YSCLTST2*!,YSCLTST3!
   YSCLTLS(     YSCLTST2*
   YSCLTLS("A"  YSCLTST2
   YSCLTLS("B"  YSCLTST2
   YSCLTLS("T"  YSCLTST2
   YSCLTLS("W"  YSCLTST2
   YSCLTLS1     YSCLTST3!
   YSCLTMP6     YSCLTST5*~
   YSCLTPT      YSCLTST2*,YSCLTST3!
   YSCLTRDT     YSCLTST5*~
   YSCLTS1      YSCLTST3*!
>> YSCLTS2      YSCLTST3*
   YSCLTST      YSCLTST3*!
   YSCLTYPE     YSCLSERV!,YSCLTST3!
   YSCLUD       YSCL122P~,YSCLDIS~
   YSCLWB       YSCLSERV*!
   YSCLWBC      YSCLTST2*!,YSCLTST3!,YSCLTST5*,YSCLTST6*
   YSCLWBCC     YSCLTST3!
   YSCLWBCT     YSCLTST3!
   YSCLX        YSCLSERV*!,YSCLTST3!,YSCLTST5*~,YSCLTST6*
   YSCLXANC     YSCLTST2~
   YSCLXANC(    YSCLTST2*
   YSCLXWBC     YSCLTST2~
   YSCLXWBC(    YSCLTST2*
   YSCLYANC     YSCLTST2~
   YSCLYANC(    YSCLTST2*
   YSCLYANC(0   YSCLTST2
   YSCLYN       YSCLSERV!
   YSCLYWBC     YSCLTST2~
   YSCLYWBC(    YSCLTST2*
   YSCLYWBC(0   YSCLTST2
   YSCLZ2       YSCLTST3!
>> YSCXDATE     YSCLTST2*
   YSDEBUG      YSCLSERV*!,YSCLSRV1,YSCLTST2*,YSCLTST3*!,YSCLTST5*~
   YSI          YSCLSERV!,YSCLSRV1*!
   YSOFF        YSCLSERV*!,YSCLTST3!
   YSPR         YSCLSERV!
   YSRACE       YSCLTST3*!,YSCLTST5*~
   YSRC         YSCLTST3*!,YSCLTST5*~
   YSSTOP       YSCLTST2*,YSCLTST3*!,YSCLTST5*~,YSCLTST6*
>> YSSTRT       YSCLTST5*
   YSTEXT       YSCLTST3!
   ZTDESC       YSCLTST2*!,YSCLTST3!
   ZTDTH        YSCLTST2*,YSCLTST3!
   ZTIO         YSCLTST2*,YSCLTST3!
   ZTQUEUED     YSCLSERV!
   ZTREQ        YSCLTST3!
   ZTRTN        YSCLTST2*,YSCLTST3!
   ZTSAVE       YSCLTST3!
   ZTSAVE("YSCLED" 
                YSCLTST2*
   ZTSK         YSCLSERV!
   ZTSTOP       YSCLTST3!

Global Variables
   ^%ZOSF("PROD"       YSCLDIS,YSCLSERV,YSCLSRV1,YSCLTST2,YSCLTST3
   ^%ZOSF("RSUM"       YSCLSRV1
   ^%ZOSF("TEST"       YSCLSRV1
   ^%ZOSF("UCI"        YSCLDIS,YSCLSERV,YSCLSRV1,YSCLTST2,YSCLTST3
   ^%ZOSF("UPPERCASE"  YSCLSERV
   ^DD("DD"            YSCLSERV
   ^DIC(4              YSCLTST5
   ^DIC(42             YSCLTST5
   ^DIC(5              YSCLTST5
   ^DPT(               YSCLDIS,YSCLSERV,YSCLTST3,YSCLTST5,YSCLTST6
   ^DPT("SSN"          YSCLSERV
   ^LAB(60             YSCLTST2,YSCLTST3
   ^OR(100             YSCLTST5
   ^PS(52.52           YSCLTST6
   ^PS(53.8            YSCLTST5
   ^PS(55              YSCL122P,YSCLDIS,YSCLTST2,YSCLTST3,YSCLTST5*,YSCLTST6*
   ^PS(59              YSCLTST3,YSCLTST5,YSCLTST6
   ^PSDRUG(            YSCLTST2,YSCLTST5
   ^PSDRUG("ACLOZ"     YSCL122P,YSCLDIS
   ^PSRX(              YSCL122P,YSCLDIS,YSCLTST6
   ^SC(                YSCLTST5
   ^TMP("LRRR"         YSCLTST2!
   ^TMP("YSCL"         YSCL122P*,YSCLDIS*!,YSCLDIS*,YSCLSRV1*!,YSCLTST2*
                       YSCLTST3*!,YSCLTST5*!,YSCLTST6*!
   ^TMP("YSCLL"        YSCLTST3*!,YSCLTST5*!,YSCLTST6!
   ^TMP($J             YSCLSERV*!,YSCLTST3*!,YSCLTST5*!,YSCLTST6*!
   ^VA(200             YSCLTST3,YSCLTST5,YSCLTST6
   ^XTMP("YSCLDATA"    YSCL122P*!,YSCLDIS*!
   ^XTMP("YSCLDEM"     YSCL122P*,YSCLTST5*
   ^XTMP("YSCLDIS"     YSCL122P!,YSCLDIS*!,YSCLTST5*
   ^XTMP("YSCLDISPOST" YSCL122P!
   ^XTMP("YSCLTRN"     YSCL122P*,YSCLTST5*,YSCLTST6*
   ^YSCL(603.01        YSCLSERV*!,YSCLTST2,YSCLTST3,YSCLTST5,YSCLTST6
   ^YSCL(603.02        YSCLTST2*
   ^YSCL(603.03        YSCLDIS*,YSCLSERV*,YSCLTST2*,YSCLTST3*,YSCLTST5
   ^YSCL(603.04        YSCLTST2,YSCLTST3

Naked Globals
   ^(           YSCLTST3,YSCLTST5
   ^(0          YSCLTST2,YSCLTST3,YSCLTST5,YSCLTST6

Cache Objects
   NONE

Marked Items
   $T(          YSCLSRV1
   $T(ROU+YSI   YSCLSRV1

Routine             Invokes:
   YSCL122P     %DTC,DIE,$$SITE^VASITE,TR^YSCLDIS,DMG^YSCLTST5
   YSCLDIS      %DTC,DIE,$$GET1^DIQ,$$SITE^VASITE,$$NOW^XLFDT,XMD,DMG^YSCLTST5
   YSCLSERV     %DT,H^%DTC,YMD^%DTC,MIX^DIC1,FILE^DICN,$$SITE^VASITE,XMD
                CL1API^YSCLSRV2,CLAPI^YSCLSRV2,DCON^YSCLSRV2,OVRRID^YSCLSRV2
                REBUILD^YSCLSRV2,REPORT^YSCLSRV2,YSCLSRV3,AUTH^YSCLSRV3
                DEMOG^YSCLSRV3,LOCK^YSCLSRV3,SERV^YSCLTST2
   YSCLSRV1     XMD
   YSCLTST2     %DT,C^%DTC,H^%DTC,$$S^%ZTLOAD,DIR,RR^LR7OR1,$$SITE^VASITE
                $$FMTE^XLFDT,$$NOW^XLFDT,XMD,ABORT^YSCLTEST,REXMIT^YSCLTEST
                END1^YSCLTST3,CL1^YSCLTST4
   YSCLTST3     %DT,$$S^%ZTLOAD,DIE,UPDATE^DIE,VAL^DIE,DIR,ADD^VADPT,DEM^VADPT
                $$SITE^VASITE,$$NOW^XLFDT,XMD,END^YSCLTST2
   YSCLTST5     C^%DTC,NOW^%DTC,$$S^%ZTLOAD,$$GET1^DIQ,GETS^DIQ,ADD^VADPT
                DEM^VADPT,$$SITE^VASITE,$$FMTE^XLFDT,START^YSCLDIS,LAB^YSCLTST1
                TRANSMIT^YSCLTST2,TRANSMIT^YSCLTST3
   YSCLTST6     $$S^%ZTLOAD,DEM^VADPT,$$SITE^VASITE,$$FMTE^XLFDT,$$CL^YSCLTST2
                DMG^YSCLTST5,DMG1^YSCLTST5,GET^YSCLTST5
   |opt         YSCLTST5,XMIT^YSCLTST5

Routine             is Invoked by:
   ^%DT                YSCLSERV,YSCLTST2,YSCLTST3
   ^%DTC               YSCL122P,YSCLDIS
   C^%DTC              YSCLTST2,YSCLTST5
   H^%DTC              YSCLSERV,YSCLTST2
   NOW^%DTC            YSCLTST5
   YMD^%DTC            YSCLSERV
   $$S^%ZTLOAD         YSCLTST2,YSCLTST3,YSCLTST5,YSCLTST6
   MIX^DIC1            YSCLSERV
   FILE^DICN           YSCLSERV
   ^DIE                YSCL122P,YSCLDIS,YSCLTST3
   UPDATE^DIE          YSCLTST3
   VAL^DIE             YSCLTST3
   $$GET1^DIQ          YSCLDIS,YSCLTST5
   GETS^DIQ            YSCLTST5
   ^DIR                YSCLTST2,YSCLTST3
   RR^LR7OR1           YSCLTST2
   ADD^VADPT           YSCLTST3,YSCLTST5
   DEM^VADPT           YSCLTST3,YSCLTST5,YSCLTST6
   $$SITE^VASITE       YSCL122P,YSCLDIS,YSCLSERV,YSCLTST2,YSCLTST3,YSCLTST5
                       YSCLTST6
   $$FMTE^XLFDT        YSCLTST2,YSCLTST5,YSCLTST6
   $$NOW^XLFDT         YSCLDIS,YSCLTST2,YSCLTST3
   ^XMD                YSCLDIS,YSCLSERV,YSCLSRV1,YSCLTST2,YSCLTST3
   START^YSCLDIS       YSCLTST5
   TR^YSCLDIS          YSCL122P
   CL1API^YSCLSRV2     YSCLSERV
   CLAPI^YSCLSRV2      YSCLSERV
   DCON^YSCLSRV2       YSCLSERV
   OVRRID^YSCLSRV2     YSCLSERV
   REBUILD^YSCLSRV2    YSCLSERV
   REPORT^YSCLSRV2     YSCLSERV
   ^YSCLSRV3           YSCLSERV
   AUTH^YSCLSRV3       YSCLSERV
   DEMOG^YSCLSRV3      YSCLSERV
   LOCK^YSCLSRV3       YSCLSERV
   ABORT^YSCLTEST      YSCLTST2
   REXMIT^YSCLTEST     YSCLTST2
   LAB^YSCLTST1        YSCLTST5
   $$CL^YSCLTST2       YSCLTST6
   END^YSCLTST2        YSCLTST3
   SERV^YSCLTST2       YSCLSERV
   TRANSMIT^YSCLTST2   YSCLTST5
   END1^YSCLTST3       YSCLTST2
   TRANSMIT^YSCLTST3   YSCLTST5
   CL1^YSCLTST4        YSCLTST2
   ^YSCLTST5           |opt
   DMG^YSCLTST5        YSCL122P,YSCLDIS,YSCLTST6
   DMG1^YSCLTST5       YSCLTST6
   GET^YSCLTST5        YSCLTST6
   XMIT^YSCLTST5       |opt

*****   END   *****


--- END ---