YSCLSRV2 ;DALOI/RLM,HEC/HRUBOVCAK,NCR/MCF - Clozapine data server ; Jun 06, 2023@13:48
 ;;5.01;MENTAL HEALTH;**69,90,92,154,166,227**;Dec 30, 1994;Build 17
 ;
 ; 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 ^LAB(60 supported by IA #333
 ; Reference to ^%DT supported by DBIA #10003
 ; 
REPORT ;send report of current registrations to the Clozapine group on Forum
 ;
 S XMRG="",YSCLA=0 F  S YSCLA=$O(^YSCL(603.01,YSCLA)) Q:'YSCLA  S YSCLDTA=$G(^YSCL(603.01,YSCLA,0)) D
  . I YSCLDTA="" S YSCLER="Clozapine Patient List damaged at " D OUT Q
  . N YSDFN,YSDPT0 S YSDFN=+$P(YSCLDTA,U,2),YSDPT0=$G(^DPT(YSDFN,0))
  . I YSCLDTA="" S YSCLER="Clozapine Patient List patient info missing for IEN: "_YSCLA_" at " D OUT Q
  . S YSCLWB=$P(YSCLDTA,U,3),YSCLWB=$S(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")
  . S YSCLER=$P(YSCLDTA,U)_" is assigned to "_$P(YSDPT0,U)_" ("_$P(YSDPT0,U,9)_") "_YSCLWB_" at " D OUT
 D ADD2TXT^YSCLSERV("==========")
 D ADD2TXT^YSCLSERV("  Linked Tests:")
 S YSCLA=0 F  S YSCLA=$O(^YSCL(603.04,1,1,YSCLA)) Q:'YSCLA  D
  . D ADD2TXT^YSCLSERV($P(^LAB(60,$P(^YSCL(603.04,1,1,YSCLA,0),U,1),0),U))
  . S YSCLTYPE=$P(^YSCL(603.04,1,1,YSCLA,0),U,2),YSCLRPT=$P(^YSCL(603.04,1,1,YSCLA,0),U,3)
  . S YSCLTA="  reports  "_$S(YSCLTYPE="W":"WHITE BLOOD COUNT",YSCLTYPE="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLTYPE="N":"NEUTROPHIL PERCENT",YSCLTYPE="S":"SEGS %",YSCLTYPE="B":"BANDS %",YSCLTYPE="T":"BANDS A",YSCLTYPE="C":"SEGS A")
  . D ADD2TXT^YSCLSERV(YSCLTA_"  "_$S(YSCLRPT:"K/units",1:"units"))
 D ADD2TXT^YSCLSERV("==========")
 ;D OPTION^%ZTLOAD("YSCL WEEKLY TRANSMISSION","LIST") D
 ; . S ZTSK="" F  S ZTSK=$O(LIST(ZTSK)) Q:ZTSK=""  D
 ; . . D STAT^%ZTLOAD D ADD2TXT^YSCLSERV("Local Task # "_ZTSK_" is "_$S('ZTSK(0):" not ",1:"")_"defined with a status of "_ZTSK(2)
 D ADD2TXT^YSCLSERV("              Run day is: "_$P(^YSCL(603.03,1,0),U,2))
 D ADD2TXT^YSCLSERV("           Debug Mode is: "_$S($P(^YSCL(603.03,1,0),U,3):"On.",1:"Off."))
 D ADD2TXT^YSCLSERV("Last Run Date (start) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),U,4)))
 D ADD2TXT^YSCLSERV(" Last Run Date (stop) is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),U,5)))
 D ADD2TXT^YSCLSERV("Last Demographic date is: "_$$FMTE^XLFDT($P(^YSCL(603.03,1,0),U,6)))
 Q
OUT D ADD2TXT^YSCLSERV(XMRG_YSCLER_YSCLST) Q
 ;Build the text for the return message here.
REBUILD ;
 S XMRG="",(YSCLA,YSCLLNT)=1 F  S YSCLA=$O(^PS(55,"ASAND1",YSCLA)) W:'$D(ZTQUEUED) "." Q:YSCLA=""  D
  . S YSCLB=$O(^PS(55,"ASAND1",YSCLA,"")) I YSCLB="" S YSCLER=" record is in error (1) at " D OUT Q
  . I '$D(^PS(55,YSCLB,0)) S YSCLER=" record is in error (2) at " D OUT Q
  . S YSCLB=$P(^PS(55,YSCLB,0),U) I YSCLB="" S YSCLER=" record is in error (3) at " D OUT Q
  . I '$D(^PS(55,YSCLB,"SAND")) S YSCLER=" record is in error (4) at " D OUT Q
  . S DIC="^DPT(",DIC(0)="X",D="SSN",(YSCLSSN,X)=$P(^DPT(YSCLB,0),U,9)
  . I $D(^YSCL(603.01,"B",YSCLA)) S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),U,2),YSCLER=" Clozapine # "_YSCLA_" is in use by "_$P($G(^DPT(YSCLX,0)),U)_" at " D OUT Q
  . D MIX^DIC1 S YSCLPT=+Y I Y=-1 S YSCLER=" could not be added at " D OUT Q
  . K DD S DIC="^YSCL(603.01,",X=YSCLA,DIC("DR")="1////"_YSCLPT K DO D FILE^DICN
  . S YSCLX=$O(^YSCL(603.01,"B",YSCLA,"")) S:YSCLX]"" YSCLX=$P(^YSCL(603.01,YSCLX,0),U,2),YSCLER=","_YSCLSSN_" assigned to "_$P($G(^DPT(YSCLX,0)),U)_" at " D OUT
 Q
OVRRID ;Update record with Monthly, Weekly or Bi-weekly status
 N YSPTMUOK S YSPTMUOK=1
 F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
  . I XMRG'?2U5N1","9N1",".E 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 format " D OUT Q
  . I $P(XMRG,",",2)'?9N S YSCLER=" An SSN must be 9 numbers " D OUT Q
  . K %DT S X=$P(XMRG,",",3),%DT="F" D ^%DT I Y=-1 S YSCLER=" is an invalid date, over-ride authorization not filed at " D OUT Q
  . S YSCLOVR=Y
  . 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 owner " D OUT Q
  . ; JCH - Begin PSO*7*612 Handle multiple Clozapine Numbers for the same patient
  . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0))  ; IEN from B x-ref for NCCC number
  . ; Check all Clozapine Numbers associated with patient in 603.01, not just the first/oldest entry
  . I YSCLDA1'=$O(^YSCL(603.01,"C",YSCLDA,0)) S YSPTMUOK=0 N YSPTNUM S YSPTNUM=0 F  S YSPTNUM=$O(^YSCL(603.01,"C",YSCLDA,YSPTNUM)) Q:'YSPTNUM!$G(YSPTNUOK)  I YSCLDA1=YSPTNUM S YSPTMUOK=1
  . I '$G(YSPTMUOK) S YSCLER=YSCLNM_" is not assigned to "_" SSN ("_YSCLSSN_","_$P(^DPT(YSCLDA,0),U)_") at " D OUT
  . I YSPTMUOK!($O(^YSCL(603.01,"B",YSCLNM,0))=$O(^YSCL(603.01,"C",YSCLDA,0))) D
  . . ; JCH - End PSO*7*612
  . . S YSCLDA1=$O(^YSCL(603.01,"B",YSCLNM,0)) S $P(^YSCL(603.01,YSCLDA1,0),U,4)=YSCLOVR
  . . S Y=YSCLOVR D DD^%DT S YSCLER=" "_YSCLNM_" ("_$P(^DPT(YSCLDA,0),U)_") authorized for over-ride on "_Y_" at " D OUT
  . . K ^XTMP("PSJ4D-"_+$G(YSCLDA)),^XTMP("PSO4D-"_+$G(YSCLDA))    ; JCH - PSO*7*612. Local Overrides are now obsolete, replaced by NCCC Override.
 G EXIT^YSCLSERV
 ;
CLAPI ;
 F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
  . ;Verify that a valid Clozapine number is listed
  . S YSCLDA=$E(XMRG,1,7)
  . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q
  . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),U,2)
  . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q
  . S YSCLNM=$$CL^YSCLTST2(YSCLDA) S YSCLER=" = "_YSCLNM_" at " D OUT
  . Q
  G EXIT^YSCLSERV
CL1API ;
 F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
  . ;Verify that a valid Clozapine number is listed
  . S YSA=$P(XMRG,U,1),YSCLDA=$P(XMRG,U,2)
  . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q
  . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),U,2)
  . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q
  . D CL1^YSCLTST2(YSCLDA,YSA) D
  . . S YSCLDA1="" F  S YSCLDA1=$O(^TMP($J,"PSO",YSCLDA1)) Q:'YSCLDA1  S YSCLER=" = "_YSCLDA_"="_(9999999-YSCLDA1)_" = "_^TMP($J,"PSO",YSCLDA1)_" at " D OUT
  . Q
  G EXIT^YSCLSERV
 ;
DCON ;
 N DR,YSA,YSCLDA,YSCLSTAT
 F  X XMREC Q:XMER<0  S XMRG=$TR(XMRG,"- ","") D
  . ;Verify that a valid Clozapine number is listed
  . S (YSA,YSCLDA)=$E(XMRG,1,7)
  . I YSCLDA'?2U5N S YSCLER=" is not a valid Clozapine number " D OUT Q
  . S YSCLDA=$O(^YSCL(603.01,"B",YSCLDA,"")),YSCLDA=$P($G(^YSCL(603.01,YSCLDA,0)),U,2)
  . I 'YSCLDA S YSCLER=" is not in the local database." D OUT Q
  . ; YS*5.01*227 - I $P(^PS(55,YSCLDA,"SAND"),U,2)'="D" S YSCLER=YSA_" is not discontinued" D OUT Q
  . ;             - S YSCLER=YSA_" was "_$P(^PS(55,YSCLDA,"SAND"),U,2)_" is now ""A"" " D OUT
  . ;             - S $P(^PS(55,YSCLDA,"SAND"),U,2)="A"
  . ;
  . ; YS*5.01*227 - begin logic to toggle between "A" and "D". Active and Discontinued.
  . D PSS^PSS781(YSCLDA,YSA,"YSDC")
  . S YSCLSTAT=$P(^TMP($J,"YSDC",YSCLDA,54),U,1)
  . S DR=$S(YSCLSTAT="A":"D",YSCLSTAT="D":"A",1:0)
  . I DR=0 S YSCLER=" is neither in the Active or Discontinued state and cannot be toggled at site " D OUT Q
  . S YSCLSTAT=$S(YSCLSTAT="A":"Discontinued",YSCLSTAT="D":"Active",1:0) ; set to opposite status.
  . D WRT^PSS781(YSCLDA,DR,"YSDC")
  . I '^TMP($J,"YSDC",0) K ^TMP($J,"YSDC") S YSCLER="Failed to set patient status to "_YSCLSTAT_" at site " D OUT Q
  . K ^TMP($J,"YSDC")
  . S YSCLER=" has been toggled to a status of "_YSCLSTAT_" at site " D OUT
  . ; end
  G EXIT^YSCLSERV ; YS^5.01^227 - set up to send mail.
  Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLSRV2   8393     printed  Sep 23, 2025@19:49:56                                                                                                                                                                                                    Page 2
YSCLSRV2  ;DALOI/RLM,HEC/HRUBOVCAK,NCR/MCF - Clozapine data server ; Jun 06, 2023@13:48
 +1       ;;5.01;MENTAL HEALTH;**69,90,92,154,166,227**;Dec 30, 1994;Build 17
 +2       ;
 +3       ; Reference to ^%ZOSF supported by IA #10096
 +4       ; Reference to ^DPT supported by IA #10035
 +5       ; Reference to ^DD("DD" supported by IA #10017
 +6       ; Reference to ^PS(55 supported by IA #787
 +7       ; Reference to ^PSDRUG supported by IA #25
 +8       ; Reference to ^PSRX supported by IA #780
 +9       ; Reference to ^VA(200 supported by IA #10060
 +10      ; Reference to $$SITE^VASITE supported by IA #10112
 +11      ; Reference to $$FMTE^XLFDT() supported by IA #10103
 +12      ; Reference to ^PSDRUG supported by IA #221
 +13      ; Reference to ^LAB(60 supported by IA #333
 +14      ; Reference to ^%DT supported by DBIA #10003
 +15      ; 
REPORT    ;send report of current registrations to the Clozapine group on Forum
 +1       ;
 +2        SET XMRG=""
           SET YSCLA=0
           FOR 
               SET YSCLA=$ORDER(^YSCL(603.01,YSCLA))
               if 'YSCLA
                   QUIT 
               SET YSCLDTA=$GET(^YSCL(603.01,YSCLA,0))
               Begin DoDot:1
 +3                IF YSCLDTA=""
                       SET YSCLER="Clozapine Patient List damaged at "
                       DO OUT
                       QUIT 
 +4                NEW YSDFN,YSDPT0
                   SET YSDFN=+$PIECE(YSCLDTA,U,2)
                   SET YSDPT0=$GET(^DPT(YSDFN,0))
 +5                IF YSCLDTA=""
                       SET YSCLER="Clozapine Patient List patient info missing for IEN: "_YSCLA_" at "
                       DO OUT
                       QUIT 
 +6                SET YSCLWB=$PIECE(YSCLDTA,U,3)
                   SET YSCLWB=$SELECT(YSCLWB="M":"Monthly",YSCLWB="W":"Weekly",YSCLWB="B":"Bi-weekly",1:"Unknown")
 +7                SET YSCLER=$PIECE(YSCLDTA,U)_" is assigned to "_$PIECE(YSDPT0,U)_" ("_$PIECE(YSDPT0,U,9)_") "_YSCLWB_" at "
                   DO OUT
               End DoDot:1
 +8        DO ADD2TXT^YSCLSERV("==========")
 +9        DO ADD2TXT^YSCLSERV("  Linked Tests:")
 +10       SET YSCLA=0
           FOR 
               SET YSCLA=$ORDER(^YSCL(603.04,1,1,YSCLA))
               if 'YSCLA
                   QUIT 
               Begin DoDot:1
 +11               DO ADD2TXT^YSCLSERV($PIECE(^LAB(60,$PIECE(^YSCL(603.04,1,1,YSCLA,0),U,1),0),U))
 +12               SET YSCLTYPE=$PIECE(^YSCL(603.04,1,1,YSCLA,0),U,2)
                   SET YSCLRPT=$PIECE(^YSCL(603.04,1,1,YSCLA,0),U,3)
 +13               SET YSCLTA="  reports  "_$SELECT(YSCLTYPE="W":"WHITE BLOOD COUNT",YSCLTYPE="A":"ABSOLUTE NEUTROPHIL COUNT",YSCLTYPE="N":"NEUTROPHIL PERCENT",YSCLTYPE="S":"SEGS %",YSCLTYPE="B":"BANDS %",YSCLTYPE="T":"BANDS A",YSCLTYPE="C":"SEGS A")
 +14               DO ADD2TXT^YSCLSERV(YSCLTA_"  "_$SELECT(YSCLRPT:"K/units",1:"units"))
               End DoDot:1
 +15       DO ADD2TXT^YSCLSERV("==========")
 +16      ;D OPTION^%ZTLOAD("YSCL WEEKLY TRANSMISSION","LIST") D
 +17      ; . S ZTSK="" F  S ZTSK=$O(LIST(ZTSK)) Q:ZTSK=""  D
 +18      ; . . D STAT^%ZTLOAD D ADD2TXT^YSCLSERV("Local Task # "_ZTSK_" is "_$S('ZTSK(0):" not ",1:"")_"defined with a status of "_ZTSK(2)
 +19       DO ADD2TXT^YSCLSERV("              Run day is: "_$PIECE(^YSCL(603.03,1,0),U,2))
 +20       DO ADD2TXT^YSCLSERV("           Debug Mode is: "_$SELECT($PIECE(^YSCL(603.03,1,0),U,3):"On.",1:"Off."))
 +21       DO ADD2TXT^YSCLSERV("Last Run Date (start) is: "_$$FMTE^XLFDT($PIECE(^YSCL(603.03,1,0),U,4)))
 +22       DO ADD2TXT^YSCLSERV(" Last Run Date (stop) is: "_$$FMTE^XLFDT($PIECE(^YSCL(603.03,1,0),U,5)))
 +23       DO ADD2TXT^YSCLSERV("Last Demographic date is: "_$$FMTE^XLFDT($PIECE(^YSCL(603.03,1,0),U,6)))
 +24       QUIT 
OUT        DO ADD2TXT^YSCLSERV(XMRG_YSCLER_YSCLST)
           QUIT 
 +1       ;Build the text for the return message here.
REBUILD   ;
 +1        SET XMRG=""
           SET (YSCLA,YSCLLNT)=1
           FOR 
               SET YSCLA=$ORDER(^PS(55,"ASAND1",YSCLA))
               if '$DATA(ZTQUEUED)
                   WRITE "."
               if YSCLA=""
                   QUIT 
               Begin DoDot:1
 +2                SET YSCLB=$ORDER(^PS(55,"ASAND1",YSCLA,""))
                   IF YSCLB=""
                       SET YSCLER=" record is in error (1) at "
                       DO OUT
                       QUIT 
 +3                IF '$DATA(^PS(55,YSCLB,0))
                       SET YSCLER=" record is in error (2) at "
                       DO OUT
                       QUIT 
 +4                SET YSCLB=$PIECE(^PS(55,YSCLB,0),U)
                   IF YSCLB=""
                       SET YSCLER=" record is in error (3) at "
                       DO OUT
                       QUIT 
 +5                IF '$DATA(^PS(55,YSCLB,"SAND"))
                       SET YSCLER=" record is in error (4) at "
                       DO OUT
                       QUIT 
 +6                SET DIC="^DPT("
                   SET DIC(0)="X"
                   SET D="SSN"
                   SET (YSCLSSN,X)=$PIECE(^DPT(YSCLB,0),U,9)
 +7                IF $DATA(^YSCL(603.01,"B",YSCLA))
                       SET YSCLX=$ORDER(^YSCL(603.01,"B",YSCLA,""))
                       if YSCLX]""
                           SET YSCLX=$PIECE(^YSCL(603.01,YSCLX,0),U,2)
                           SET YSCLER=" Clozapine # "_YSCLA_" is in use by "_$PIECE($GET(^DPT(YSCLX,0)),U)_" at "
                       DO OUT
                       QUIT 
 +8                DO MIX^DIC1
                   SET YSCLPT=+Y
                   IF Y=-1
                       SET YSCLER=" could not be added at "
                       DO OUT
                       QUIT 
 +9                KILL DD
                   SET DIC="^YSCL(603.01,"
                   SET X=YSCLA
                   SET DIC("DR")="1////"_YSCLPT
                   KILL DO
                   DO FILE^DICN
 +10               SET YSCLX=$ORDER(^YSCL(603.01,"B",YSCLA,""))
                   if YSCLX]""
                       SET YSCLX=$PIECE(^YSCL(603.01,YSCLX,0),U,2)
                       SET YSCLER=","_YSCLSSN_" assigned to "_$PIECE($GET(^DPT(YSCLX,0)),U)_" at "
                   DO OUT
               End DoDot:1
 +11       QUIT 
OVRRID    ;Update record with Monthly, Weekly or Bi-weekly status
 +1        NEW YSPTMUOK
           SET YSPTMUOK=1
 +2        FOR 
               XECUTE XMREC
               if XMER<0
                   QUIT 
               SET XMRG=$TRANSLATE(XMRG,"- ","")
               Begin DoDot:1
 +3                IF XMRG'?2U5N1","9N1",".E
                       SET YSCLER=" is in error and was not added at "
                       DO OUT
                       QUIT 
 +4                IF $PIECE(XMRG,",")'?2U5N
                       SET YSCLER=" is not a valid Clozapine number format "
                       DO OUT
                       QUIT 
 +5                IF $PIECE(XMRG,",",2)'?9N
                       SET YSCLER=" An SSN must be 9 numbers "
                       DO OUT
                       QUIT 
 +6                KILL %DT
                   SET X=$PIECE(XMRG,",",3)
                   SET %DT="F"
                   DO ^%DT
                   IF Y=-1
                       SET YSCLER=" is an invalid date, over-ride authorization not filed at "
                       DO OUT
                       QUIT 
 +7                SET YSCLOVR=Y
 +8                SET YSCLNM=$PIECE(XMRG,",")
                   SET YSCLSSN=$PIECE(XMRG,",",2)
                   SET YSCLWB=$PIECE(XMRG,",",3)
 +9                IF '$DATA(^YSCL(603.01,"B",YSCLNM))
                       SET YSCLER=" does not exist at "
                       DO OUT
                       QUIT 
 +10               SET YSCLDA=$ORDER(^DPT("SSN",YSCLSSN,0))
 +11               IF YSCLDA=""
                       SET YSCLER=" SSN does not exist at "
                       DO OUT
                       QUIT 
 +12               IF $ORDER(^YSCL(603.01,"B",YSCLNM,0))=""
                       SET YSCLER=" SSN not in Clozapine file "
                       DO OUT
                       QUIT 
 +13               IF $ORDER(^DPT("SSN",YSCLSSN,YSCLDA))
                       SET YSCLER=" SSN has more than one owner "
                       DO OUT
                       QUIT 
 +14      ; JCH - Begin PSO*7*612 Handle multiple Clozapine Numbers for the same patient
 +15      ; IEN from B x-ref for NCCC number
                   SET YSCLDA1=$ORDER(^YSCL(603.01,"B",YSCLNM,0))
 +16      ; Check all Clozapine Numbers associated with patient in 603.01, not just the first/oldest entry
 +17               IF YSCLDA1'=$ORDER(^YSCL(603.01,"C",YSCLDA,0))
                       SET YSPTMUOK=0
                       NEW YSPTNUM
                       SET YSPTNUM=0
                       FOR 
                           SET YSPTNUM=$ORDER(^YSCL(603.01,"C",YSCLDA,YSPTNUM))
                           if 'YSPTNUM!$GET(YSPTNUOK)
                               QUIT 
                           IF YSCLDA1=YSPTNUM
                               SET YSPTMUOK=1
 +18               IF '$GET(YSPTMUOK)
                       SET YSCLER=YSCLNM_" is not assigned to "_" SSN ("_YSCLSSN_","_$PIECE(^DPT(YSCLDA,0),U)_") at "
                       DO OUT
 +19               IF YSPTMUOK!($ORDER(^YSCL(603.01,"B",YSCLNM,0))=$ORDER(^YSCL(603.01,"C",YSCLDA,0)))
                       Begin DoDot:2
 +20      ; JCH - End PSO*7*612
 +21                       SET YSCLDA1=$ORDER(^YSCL(603.01,"B",YSCLNM,0))
                           SET $PIECE(^YSCL(603.01,YSCLDA1,0),U,4)=YSCLOVR
 +22                       SET Y=YSCLOVR
                           DO DD^%DT
                           SET YSCLER=" "_YSCLNM_" ("_$PIECE(^DPT(YSCLDA,0),U)_") authorized for over-ride on "_Y_" at "
                           DO OUT
 +23      ; JCH - PSO*7*612. Local Overrides are now obsolete, replaced by NCCC Override.
                           KILL ^XTMP("PSJ4D-"_+$GET(YSCLDA)),^XTMP("PSO4D-"_+$GET(YSCLDA))
                       End DoDot:2
               End DoDot:1
 +24       GOTO EXIT^YSCLSERV
 +25      ;
CLAPI     ;
 +1        FOR 
               XECUTE XMREC
               if XMER<0
                   QUIT 
               SET XMRG=$TRANSLATE(XMRG,"- ","")
               Begin DoDot:1
 +2       ;Verify that a valid Clozapine number is listed
 +3                SET YSCLDA=$EXTRACT(XMRG,1,7)
 +4                IF YSCLDA'?2U5N
                       SET YSCLER=" is not a valid Clozapine number "
                       DO OUT
                       QUIT 
 +5                SET YSCLDA=$ORDER(^YSCL(603.01,"B",YSCLDA,""))
                   SET YSCLDA=$PIECE($GET(^YSCL(603.01,YSCLDA,0)),U,2)
 +6                IF 'YSCLDA
                       SET YSCLER=" is not in the local database."
                       DO OUT
                       QUIT 
 +7                SET YSCLNM=$$CL^YSCLTST2(YSCLDA)
                   SET YSCLER=" = "_YSCLNM_" at "
                   DO OUT
 +8                QUIT 
               End DoDot:1
 +9        GOTO EXIT^YSCLSERV
CL1API    ;
 +1        FOR 
               XECUTE XMREC
               if XMER<0
                   QUIT 
               SET XMRG=$TRANSLATE(XMRG,"- ","")
               Begin DoDot:1
 +2       ;Verify that a valid Clozapine number is listed
 +3                SET YSA=$PIECE(XMRG,U,1)
                   SET YSCLDA=$PIECE(XMRG,U,2)
 +4                IF YSCLDA'?2U5N
                       SET YSCLER=" is not a valid Clozapine number "
                       DO OUT
                       QUIT 
 +5                SET YSCLDA=$ORDER(^YSCL(603.01,"B",YSCLDA,""))
                   SET YSCLDA=$PIECE($GET(^YSCL(603.01,YSCLDA,0)),U,2)
 +6                IF 'YSCLDA
                       SET YSCLER=" is not in the local database."
                       DO OUT
                       QUIT 
 +7                DO CL1^YSCLTST2(YSCLDA,YSA)
                   Begin DoDot:2
 +8                    SET YSCLDA1=""
                       FOR 
                           SET YSCLDA1=$ORDER(^TMP($JOB,"PSO",YSCLDA1))
                           if 'YSCLDA1
                               QUIT 
                           SET YSCLER=" = "_YSCLDA_"="_(9999999-YSCLDA1)_" = "_^TMP($JOB,"PSO",YSCLDA1)_" at "
                           DO OUT
                   End DoDot:2
 +9                QUIT 
               End DoDot:1
 +10       GOTO EXIT^YSCLSERV
 +11      ;
DCON      ;
 +1        NEW DR,YSA,YSCLDA,YSCLSTAT
 +2        FOR 
               XECUTE XMREC
               if XMER<0
                   QUIT 
               SET XMRG=$TRANSLATE(XMRG,"- ","")
               Begin DoDot:1
 +3       ;Verify that a valid Clozapine number is listed
 +4                SET (YSA,YSCLDA)=$EXTRACT(XMRG,1,7)
 +5                IF YSCLDA'?2U5N
                       SET YSCLER=" is not a valid Clozapine number "
                       DO OUT
                       QUIT 
 +6                SET YSCLDA=$ORDER(^YSCL(603.01,"B",YSCLDA,""))
                   SET YSCLDA=$PIECE($GET(^YSCL(603.01,YSCLDA,0)),U,2)
 +7                IF 'YSCLDA
                       SET YSCLER=" is not in the local database."
                       DO OUT
                       QUIT 
 +8       ; YS*5.01*227 - I $P(^PS(55,YSCLDA,"SAND"),U,2)'="D" S YSCLER=YSA_" is not discontinued" D OUT Q
 +9       ;             - S YSCLER=YSA_" was "_$P(^PS(55,YSCLDA,"SAND"),U,2)_" is now ""A"" " D OUT
 +10      ;             - S $P(^PS(55,YSCLDA,"SAND"),U,2)="A"
 +11      ;
 +12      ; YS*5.01*227 - begin logic to toggle between "A" and "D". Active and Discontinued.
 +13               DO PSS^PSS781(YSCLDA,YSA,"YSDC")
 +14               SET YSCLSTAT=$PIECE(^TMP($JOB,"YSDC",YSCLDA,54),U,1)
 +15               SET DR=$SELECT(YSCLSTAT="A":"D",YSCLSTAT="D":"A",1:0)
 +16               IF DR=0
                       SET YSCLER=" is neither in the Active or Discontinued state and cannot be toggled at site "
                       DO OUT
                       QUIT 
 +17      ; set to opposite status.
                   SET YSCLSTAT=$SELECT(YSCLSTAT="A":"Discontinued",YSCLSTAT="D":"Active",1:0)
 +18               DO WRT^PSS781(YSCLDA,DR,"YSDC")
 +19               IF '^TMP($JOB,"YSDC",0)
                       KILL ^TMP($JOB,"YSDC")
                       SET YSCLER="Failed to set patient status to "_YSCLSTAT_" at site "
                       DO OUT
                       QUIT 
 +20               KILL ^TMP($JOB,"YSDC")
 +21               SET YSCLER=" has been toggled to a status of "_YSCLSTAT_" at site "
                   DO OUT
 +22      ; end
               End DoDot:1
 +23      ; YS^5.01^227 - set up to send mail.
           GOTO EXIT^YSCLSERV
 +24       QUIT 
 +25      ;