- 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 Apr 23, 2025@18:28:15 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 ;
