- YSCLTST4 ;DALOI/LB/RLM - TRANSMIT RX AND lAB DATA FOR CLOZAPINE ; Nov 27, 2018@17:15
- ;;5.01;MENTAL HEALTH;**92,122,166,227**;Dec 30, 1994;Build 17
- ;
- ; Reference to ^LAB(60 supported by IA #333
- ; Reference to ^LR7OR1 supported by IA #2503
- ; Reference to ^DIC supported by DBIA #2051
- ; Reference to ^DIQ supported by DBIA #2056
- ; Reference to ^%DTC supported by DBIA #10000
- ;
- CL1 ;(DFN,DAYS) ;
- K ^TMP($J,"PSO"),RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC
- Q:'DFN
- S:'$G(DAYS) DAYS=90
- N ARRAY D LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
- ;BEGIN: JCH - YS*5.01*166
- N YSCLPSN,PSOCZPTS,PSOERR
- ;S YSCLPSN=$$GET1^DIQ(55,DFN,53,"I") Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
- D GET55^YSCLTST2(DFN,.YSCLPSN) S YSCLPSN=$G(YSCLPSN(DFN,53)) Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
- D FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
- S YSCLIEN=$G(PSOCZPTS("DILIST",2,1))
- ;END: JCH - YS*5.01*166
- ;S YSCLIEN=$G(ARRAY("DILIST",2,1)),YSCLFRQ="" I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- S YSCLFRQ="" I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- I $$GET1^DIQ(603.03,1,7,"I")=1 Q "-1^0^0^0^0^0^"_YSCLFRQ
- S X1=DT,X2="-"_DAYS D C^%DTC S YSCLSD=X
- K ARRAY D LIST^DIC(603.41,",1,","1;2","I",,,,,,,"ARRAY")
- F I=1:1 Q:'$D(ARRAY("DILIST",2,I)) S YSCLA=ARRAY("DILIST",2,I) D
- . N YSCLTNM,YSCLTTP,YSCLTFR S YSCLTNM=ARRAY("DILIST",1,I) ;$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
- . S YSCLTTP=ARRAY("DILIST","ID",I,1)
- . S YSCLTFR=ARRAY("DILIST","ID",I,2)
- . S YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
- F I=1:1 Q:'$D(ARRAY("DILIST",1,I)) S YSCLTL=ARRAY("DILIST",1,I) 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="" D ;YS227
- . . . S YSCLTA="" F S YSCLTA=$O(^TMP("LRRR",$J,DFN,YSCLSB1,YSCLTDT,YSCLTA)) 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 D
- . . S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)*$S(YSCLTLS("W",YSCLA):1000,1:1)
- . . S ^TMP($J,"PSO",YSCLA1)=YSCLYWBC(YSCLA1)
- S YSCLRWBC=0 F S YSCLRWBC=$O(YSCLYWBC(YSCLRWBC)) Q:YSCLRWBC="" S YSCLRWBC(YSCLRWBC)=YSCLYWBC(YSCLRWBC) D
- . ;Match all ANC's and WBC's
- . S YSCLMTCH=0 F YSCLA="A","N","S","C" Q:YSCLMTCH S YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH
- . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",$D(YSCLRWBC(YSCLRWBC)) S ^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1)) Q
- . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",$D(YSCLRWBC(YSCLRWBC)) S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01))) Q
- . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",$D(YSCLRWBC(YSCLRWBC)) D Q
- . . . S (YSCLSG1,YSCLSGS)="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:'YSCLSGS!YSCLMTCH
- . . . . I 'YSCLSG1,'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
- . . . . I 'YSCLSGS,YSCLSG1 Q
- . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
- . . . . S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))) Q
- . . I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C" S YSCLMTCH=1 D
- . . . S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:'YSCLSGS!YSCLMTCH
- . . . . I '$G(YSCLSG1),'YSCLSGS S YSCLSGS="Z",YSCLSG1=1
- . . . . I 'YSCLSGS,$G(YSCLSG1) Q
- . . . . I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
- . . . . S YSCLMTCH=1,^TMP($J,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_((RESULTS(YSCLTPT,YSCLRWBC)*$S(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))+(RESULTS(YSCLSGS,YSCLRWBC))) Q
- S YSCLA="A",YSCLTPT="" F S YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D
- . S YSCLRANC="" F S YSCLRNC=$O(RESULTS(YSCLTPT,YSCLRANC)) Q:'YSCLRANC D
- . . Q:$D(^TMP($J,"PSO",YSCLRANC))
- . . S ^TMP($J,"PSO",YSCLRANC)="^"_(RESULTS(YSCLTPT,YSCLRANC)*$S(YSCLTLS("A",YSCLTPT):1000,1:1))
- K FDA,YSCLSGS,Y15,YSCLRWBC,YSCLANC,YSCLYWBC,YSCLFRQ,ZIENS,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD
- K YSCLTA,YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC,YSCLMULT
- Q
- ;
- KILL ;
- K FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
- K YSCLTDT,YSCLTL,YSCLSG1,YSCLTLS,YSCLTPT,YSCLXWBC
- ;
- ZEOR ;YSCLTST4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLTST4 4770 printed Jan 18, 2025@03:15:03 Page 2
- YSCLTST4 ;DALOI/LB/RLM - TRANSMIT RX AND lAB DATA FOR CLOZAPINE ; Nov 27, 2018@17:15
- +1 ;;5.01;MENTAL HEALTH;**92,122,166,227**;Dec 30, 1994;Build 17
- +2 ;
- +3 ; Reference to ^LAB(60 supported by IA #333
- +4 ; Reference to ^LR7OR1 supported by IA #2503
- +5 ; Reference to ^DIC supported by DBIA #2051
- +6 ; Reference to ^DIQ supported by DBIA #2056
- +7 ; Reference to ^%DTC supported by DBIA #10000
- +8 ;
- CL1 ;(DFN,DAYS) ;
- +1 KILL ^TMP($JOB,"PSO"),RESULTS,YSCLYWBC,YSCLRANC,YSCLXWBC
- +2 if 'DFN
- QUIT
- +3 if '$GET(DAYS)
- SET DAYS=90
- +4 NEW ARRAY
- DO LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
- +5 ;BEGIN: JCH - YS*5.01*166
- +6 NEW YSCLPSN,PSOCZPTS,PSOERR
- +7 ;S YSCLPSN=$$GET1^DIQ(55,DFN,53,"I") Q:YSCLPSN="" 0 ; Get current Clozapine number associated with patient's Clozapine registration
- +8 ; Get current Clozapine number associated with patient's Clozapine registration
- DO GET55^YSCLTST2(DFN,.YSCLPSN)
- SET YSCLPSN=$GET(YSCLPSN(DFN,53))
- if YSCLPSN=""
- QUIT 0
- +9 DO FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
- +10 SET YSCLIEN=$GET(PSOCZPTS("DILIST",2,1))
- +11 ;END: JCH - YS*5.01*166
- +12 ;S YSCLIEN=$G(ARRAY("DILIST",2,1)),YSCLFRQ="" I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- +13 SET YSCLFRQ=""
- IF YSCLIEN
- SET YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- +14 IF $$GET1^DIQ(603.03,1,7,"I")=1
- QUIT "-1^0^0^0^0^0^"_YSCLFRQ
- +15 SET X1=DT
- SET X2="-"_DAYS
- DO C^%DTC
- SET YSCLSD=X
- +16 KILL ARRAY
- DO LIST^DIC(603.41,",1,","1;2","I",,,,,,,"ARRAY")
- +17 FOR I=1:1
- if '$DATA(ARRAY("DILIST",2,I))
- QUIT
- SET YSCLA=ARRAY("DILIST",2,I)
- Begin DoDot:1
- +18 ;$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
- NEW YSCLTNM,YSCLTTP,YSCLTFR
- SET YSCLTNM=ARRAY("DILIST",1,I)
- +19 SET YSCLTTP=ARRAY("DILIST","ID",I,1)
- +20 SET YSCLTFR=ARRAY("DILIST","ID",I,2)
- +21 SET YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
- End DoDot:1
- +22 FOR I=1:1
- if '$DATA(ARRAY("DILIST",1,I))
- QUIT
- SET YSCLTL=ARRAY("DILIST",1,I)
- Begin DoDot:1
- +23 DO RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
- +24 SET YSCLSB1=""
- FOR
- SET YSCLSB1=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1))
- if YSCLSB1=""
- QUIT
- Begin DoDot:2
- +25 ;YS227
- SET YSCLTDT=""
- FOR
- SET YSCLTDT=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT))
- if YSCLTDT=""
- QUIT
- Begin DoDot:3
- +26 SET YSCLTA=""
- FOR
- SET YSCLTA=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA))
- if YSCLTA=""
- QUIT
- IF YSCLTA
- Begin DoDot:4
- +27 SET RESULTS1=^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA)
- +28 SET RESULTS(YSCLTL,YSCLTDT)=$PIECE(RESULTS1,"^",2)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +29 ;Find all entries for WBC and sort by inverse date.
- +30 SET YSCLA=""
- FOR
- SET YSCLA=$ORDER(YSCLTLS("W",YSCLA))
- if 'YSCLA
- QUIT
- SET YSCLXWBC(YSCLA)=""
- Begin DoDot:1
- +31 SET YSCLA1=""
- FOR
- SET YSCLA1=$ORDER(RESULTS(YSCLA,YSCLA1))
- if 'YSCLA1
- QUIT
- Begin DoDot:2
- +32 SET YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)*$SELECT(YSCLTLS("W",YSCLA):1000,1:1)
- +33 SET ^TMP($JOB,"PSO",YSCLA1)=YSCLYWBC(YSCLA1)
- End DoDot:2
- End DoDot:1
- +34 SET YSCLRWBC=0
- FOR
- SET YSCLRWBC=$ORDER(YSCLYWBC(YSCLRWBC))
- if YSCLRWBC=""
- QUIT
- SET YSCLRWBC(YSCLRWBC)=YSCLYWBC(YSCLRWBC)
- Begin DoDot:1
- +35 ;Match all ANC's and WBC's
- +36 SET YSCLMTCH=0
- FOR YSCLA="A","N","S","C"
- if YSCLMTCH
- QUIT
- SET YSCLTPT=""
- FOR
- SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
- if 'YSCLTPT
- QUIT
- Begin DoDot:2
- +37 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="A"
- IF $DATA(YSCLRWBC(YSCLRWBC))
- SET ^TMP($JOB,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(RESULTS(YSCLTPT,YSCLRWBC)*$SELECT(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))
- QUIT
- +38 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="N"
- IF $DATA(YSCLRWBC(YSCLRWBC))
- SET YSCLMTCH=1
- SET ^TMP($JOB,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)))
- QUIT
- +39 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="S"
- IF $DATA(YSCLRWBC(YSCLRWBC))
- Begin DoDot:3
- +40 SET (YSCLSG1,YSCLSGS)=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
- Begin DoDot:4
- +41 IF 'YSCLSG1
- IF 'YSCLSGS
- SET YSCLSGS="Z"
- SET YSCLSG1=1
- +42 IF 'YSCLSGS
- IF YSCLSG1
- QUIT
- +43 IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
- SET RESULTS(YSCLSGS,YSCLRWBC)=0
- +44 SET YSCLMTCH=1
- SET ^TMP($JOB,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_(YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01)))
- QUIT
- End DoDot:4
- if 'YSCLSGS!YSCLMTCH
- QUIT
- End DoDot:3
- QUIT
- +45 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="C"
- SET YSCLMTCH=1
- Begin DoDot:3
- +46 SET YSCLSGS=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
- Begin DoDot:4
- +47 IF '$GET(YSCLSG1)
- IF 'YSCLSGS
- SET YSCLSGS="Z"
- SET YSCLSG1=1
- +48 IF 'YSCLSGS
- IF $GET(YSCLSG1)
- QUIT
- +49 IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
- SET RESULTS(YSCLSGS,YSCLRWBC)=0
- +50 SET YSCLMTCH=1
- SET ^TMP($JOB,"PSO",YSCLRWBC)=YSCLRWBC(YSCLRWBC)_"^"_((RESULTS(YSCLTPT,YSCLRWBC)*$SELECT(YSCLTLS(YSCLA,YSCLTPT):1000,1:1))+(RESULTS(YSCLSGS,YSCLRWBC)))
- QUIT
- End DoDot:4
- if 'YSCLSGS!YSCLMTCH
- QUIT
- End DoDot:3
- End DoDot:2
- if YSCLMTCH
- QUIT
- End DoDot:1
- +51 SET YSCLA="A"
- SET YSCLTPT=""
- FOR
- SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
- if 'YSCLTPT
- QUIT
- Begin DoDot:1
- +52 SET YSCLRANC=""
- FOR
- SET YSCLRNC=$ORDER(RESULTS(YSCLTPT,YSCLRANC))
- if 'YSCLRANC
- QUIT
- Begin DoDot:2
- +53 if $DATA(^TMP($JOB,"PSO",YSCLRANC))
- QUIT
- +54 SET ^TMP($JOB,"PSO",YSCLRANC)="^"_(RESULTS(YSCLTPT,YSCLRANC)*$SELECT(YSCLTLS("A",YSCLTPT):1000,1:1))
- End DoDot:2
- End DoDot:1
- +55 KILL FDA,YSCLSGS,Y15,YSCLRWBC,YSCLANC,YSCLYWBC,YSCLFRQ,ZIENS,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD
- +56 KILL YSCLTA,YSCLTDT,YSCLTL,YSCLTLS,YSCLTPT,YSCLXWBC,YSCLMULT
- +57 QUIT
- +58 ;
- KILL ;
- +1 KILL FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
- +2 KILL YSCLTDT,YSCLTL,YSCLSG1,YSCLTLS,YSCLTPT,YSCLXWBC
- +3 ;
- ZEOR ;YSCLTST4