- YSCLTST2 ;DALOI/LB/RLM - TRANSMIT RX AND LAB DATA FOR CLOZAPINE ; Nov 11, 2018@03:34
- ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,166,193,227**;Dec 30, 1994;Build 17
- ;
- ; Reference to ^LAB(60 supported by IA #333
- ; Reference to ^PSDRUG supported by IA #25
- ; Reference to ^PS(55 supported by IA #787
- ; Reference to ^XMD supported by IA #10070
- ; Reference to ^LR7OR1 supported by IA #2503
- ; Reference to ^DIC supported by DBIA #2051
- ; Reference to ^DIE supported by DBIA #2053
- ; Reference to ^DIQ supported by DBIA #2056
- ; Reference to ^DIR supported by DBIA #10026
- ; Reference to $$SITE^VASITE supported by DBIA #10112
- ; Reference to ^XLFDT supported by DBIA #10103
- ; Reference to MIX^DIC1 supported by DBIA #10007
- ; Reference to ^%ZTLOAD supported by DBIA #10063
- ; Reference to ^%DTC supported by DBIA #10000
- ; Reference to ^%DT supported by DBIA #10003
- ; Reference to PSS^PSS781 supported by DBIA #4480
- ; Reference to $$GETREGYS^PSOCLUTL supported by DBIA #7314
- ;
- 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=$$GET1^DIQ(603.03,1,3,"I"),YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
- S YSPRODST=$$GET1^DIQ(603.03,1,8) ;S:YSPRODST="" YSPRODST="S.RUCLRXLAB@FO-HINES.DOMAIN.EXT"
- S YSDBGST=$$GET1^DIQ(603.03,1,10) ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
- ;/RBN - Begin modifications for YS*5.01*122
- I $G(YSCLLN) D
- .K XMY
- .I YSPROD D
- ..I 'YSDEBUG S XMY(YSPRODST)="" ;XMY("G.CLOZAPINE ROLL-UP")="" ;,
- ..E S XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")="",XMY("G.RUCLRXLAB@FO-DALLAS.DOMAIN.EXT")=""
- .E D
- ..I 'YSDEBUG S XMY(YSDBGST)=""
- ..E 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(XMZ):XMZ,1:"no data sent")
- I 'YSDEBUG S XMY("G.PSOCLOZ")="" S:YSPROD XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
- E S XMY("G.CLOZAPINE DEBUG")="" S:YSPROD XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
- S XMSUB=$S(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
- K XMZ S ^TMP("YSCL",$J,1,0)="Clozapine lab data was transmitted, "_YSCLLN_" records were sent",XMTEXT="^TMP(""YSCL"",$J," D ^XMD
- S DIE="^YSCL(603.03,",DA=1,DR="5////"_$$NOW^XLFDT D ^DIE ;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
- ;/RBN Begin modification for YS*122
- D REX^YSCLTST5
- ;/RBN End modification for YS*122
- Q
- ;
- DATE S %DT="AEXP",%DT(0)=-DT,%DT("A")="Ending date for data collection."
- D ^%DT K %DT G END:X="^",END:X="^" I Y=-1 G DATE
- ;/RBN Begin modifications for *122
- S ZTDESC="Server triggered retransmission"
- S ZTSAVE("YSCLED")="",ZTIO="",ZTRTN="REXMIT^YSCLTST5",ZTDTH=$H
- D REXMIT^YSCLTST5 G END
- ;/RBN End modifications for *122
- FLSET ;Set up file 603.02
- W @IOF,"This option specifies the blood tests associated with the Clozapine"
- W !,"reporting software. Two tests must be defined. The first is the White"
- W !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage."
- 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 patients: " 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 D
- .;YS193 - add SET of DIC(0) in next line
- .K DD S DIC="^YSCL(603.02,",DIC(0)="",X=YSCLWBC,DIC("DR")="1////"_YSCLGRN K DO D FILE^DICN
- ;Only one entry is allowed.
- K DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC
- Q
- EN(DRG) ;
- K LAB
- I $$GET1^DIQ(50,DRG,17.5)'="PSOCLO1" S LAB("NOT")=0 Q
- N YSARRAY D LIST^DIC(50.02,","_YSDRG_",",3,"I",,,,,,,"YSARRAY")
- S (CNT,I)=0 F S I=$O(YSARRAY("DILIST",2,I)) Q:'I S CNT=$G(CNT)+1
- I CNT'=2 S LAB("BAD TEST")=0 K CNT Q
- K CNT F I=1:1 Q:'$D(YSARRAY("DILIST","ID",I)) D
- .S LABT=$S(YSARRAY("DILIST","ID",I,3)=1:"WBC",1:"ANC"),YSLN=YSARRAY("DILIST",2,I)
- .S LAB(LABT)=$$GET1^DIQ(50.02,YSLN_","_DRG,.01,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,2,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,3,"I")
- K LABT,I
- Q
- CL1(DFN,DAYS) ;The routine was split due to size
- G CL1^YSCLTST4
- Q
- ;
- ;BEGIN: JCH - PSO*7*612
- CL(DFN,PSORCLOZ) ; patient must be in both file #55 and #603.01 to get lab results
- ;END: JCH - PSO*7*612
- K ^TMP("LRRR",$J) N RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ,YSCLIEN
- I 'DFN Q "-1^-1^-1^-1^-1^-1^-1"
- N ARRAY D LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
- I '$D(ARRAY("DILIST","ID")) Q "-1^-1^-1^-1^-1^-1^-1"
- ;BEGIN: JCH - YS*5.01*166 Use frequency from registered cloz auth number, otherwise most recently assigned cloz number
- S YSCLIEN=$$GETREGYS^PSOCLUTL(DFN),YSCLFRQ=""
- I YSCLIEN>0 S YSCLIEN=$O(^YSCL(603.01,"C",DFN,""),-1)
- ;END: JCH - YS*5.01*166
- I YSCLIEN S YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- I $$GET1^DIQ(603.03,1,7,"I")=1!(YSCLFRQ="") Q "-1^0^0^0^0^0^"_YSCLFRQ
- I $$GET1^DIQ(55,DFN,54,"I")'="A" Q "-1^0^0^0^0^0^"_YSCLFRQ
- ; BEGIN: JCH - PSO*7*612. If coming from CPRS, no cloz ordering if local override number currently registered
- I $G(PSORCLOZ) N ORYSIEN S ORYSIEN=$$GET1^DIQ(603.01,YSCLIEN,.01,"I") I ORYSIEN?1U6N Q "-1^0^0^0^0^0"
- ; END: JCH - PSO*7*612
- S X1=DT,X2=$$GET1^DIQ(603.03,"1,",12) D C^%DTC S YSCLSD=X ; YS*5.01*227 - Change default to new field in parameters file
- K ARRAY D LIST^DIC(603.41,",1,",,"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=$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
- . S YSCLTTP=$$GET1^DIQ(603.41,YSCLA_",1,",1,"I")
- . S YSCLTFR=$$GET1^DIQ(603.41,YSCLA_",1,",2,"I")
- . 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 ;YS*5.01*227 - No longer excluding dates without times
- . . . 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 S YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_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(YSCLYWBC(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 YSCLTPT=$O(YSCLTLS(YSCLA,YSCLTPT)) Q:'YSCLTPT D Q:YSCLMTCH
- ..S YSCLMULT=YSCLTLS(YSCLA,YSCLTPT),YSCLMULT=$S(YSCLMULT:1000,1:1)
- ..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="A",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
- ..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
- ..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="S",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D
- ...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("B",YSCLSGS)) D Q:YSCLMTCH!'YSCLSGS
- ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
- ....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01) Q
- ..I $G(RESULTS(YSCLTPT,YSCLRWBC)),YSCLA="C",RESULTS(YSCLTPT,YSCLRWBC)'?1A.E D
- ...S YSCLSGS="" F S YSCLSGS=$O(YSCLTLS("T",YSCLSGS)) D Q:YSCLMTCH!'YSCLSGS
- ....S:'YSCLSGS YSCLSGS="Z" I '$D(RESULTS(YSCLSGS,YSCLRWBC)) S RESULTS(YSCLSGS,YSCLRWBC)=0
- ....S YSCLMTCH=1,YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(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(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1000 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- ;I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC)) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ ; PWT - YS*5.01*227
- I $G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC))<1500 Q "2^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(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)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("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(YSCLYANC(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 YSCLTPT=$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)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01) Q
- ..I $D(RESULTS(YSCLTPT,YSCLRANC)),YSCLA="N",RESULTS(YSCLTPT,YSCLRANC)'?1A.E S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01) 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(YSCLSGS,YSCLRANC)=0
- ....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC)*.01)+(RESULTS(YSCLSGS,YSCLRANC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01) 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(YSCLSGS,YSCLRANC)=0
- ....S YSCLMTCH=1,YSCLRANC(YSCLRANC)=((RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT)+(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-YSCLRWBC)_"^"_YSCLFRQ
- I +$G(YSCLRANC(YSCLRWBC))<1500 Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_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
- K ^TMP("LRRR",$J) ; YS*5.01*227 - Clean up ^TMP
- Q
- ;
- OVERRIDE(DFN) ;Check for an over-ride. SEE RQ12.11
- N YSCLIEN,YSCLOVRD,ARRAY ;S YSCLIEN=$O(^YSCL(603.01,"C",DFN,0)) Q:YSCLIEN="" 0
- ;BEGIN: JCH - YS*5.01*166
- N YSCLPSN,PSOCZPTS,PSOERR,Y,X
- D GET55(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)) Q:YSCLPSN="" 0
- ;END: JCH - YS*5.01*166
- S YSCLOVRD=$$GET1^DIQ(603.01,YSCLIEN,3,"I")
- S:YSCLOVRD'=DT ANQRE=""
- I '$G(PSGCFLG),$G(YSCLOVRD),DT>YSCLOVRD S X=YSCLOVRD,YSCXDATE=$$FMTE^XLFDT(X,"D") W !,"National Override expired at midnight on "_YSCXDATE
- Q YSCLOVRD=DT
- ZEOR ;YSCLTST2
- Q
- ;
- GET55(DFN,CLOZ55) ; JCH - PSO*7*612 - Get Clozapine "SAND" node from file 55 via PDM API
- Q:'$G(DFN) ""
- K CLOZ55
- D PSS^PSS781(+DFN,"","SAND")
- M CLOZ55(DFN)=^TMP($J,"SAND",DFN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSCLTST2 13781 printed Jan 18, 2025@03:15:01 Page 2
- YSCLTST2 ;DALOI/LB/RLM - TRANSMIT RX AND LAB DATA FOR CLOZAPINE ; Nov 11, 2018@03:34
- +1 ;;5.01;MENTAL HEALTH;**18,22,26,47,61,69,74,90,92,122,166,193,227**;Dec 30, 1994;Build 17
- +2 ;
- +3 ; Reference to ^LAB(60 supported by IA #333
- +4 ; Reference to ^PSDRUG supported by IA #25
- +5 ; Reference to ^PS(55 supported by IA #787
- +6 ; Reference to ^XMD supported by IA #10070
- +7 ; Reference to ^LR7OR1 supported by IA #2503
- +8 ; Reference to ^DIC supported by DBIA #2051
- +9 ; Reference to ^DIE supported by DBIA #2053
- +10 ; Reference to ^DIQ supported by DBIA #2056
- +11 ; Reference to ^DIR supported by DBIA #10026
- +12 ; Reference to $$SITE^VASITE supported by DBIA #10112
- +13 ; Reference to ^XLFDT supported by DBIA #10103
- +14 ; Reference to MIX^DIC1 supported by DBIA #10007
- +15 ; Reference to ^%ZTLOAD supported by DBIA #10063
- +16 ; Reference to ^%DTC supported by DBIA #10000
- +17 ; Reference to ^%DT supported by DBIA #10003
- +18 ; Reference to PSS^PSS781 supported by DBIA #4480
- +19 ; Reference to $$GETREGYS^PSOCLUTL supported by DBIA #7314
- +20 ;
- TRANSMIT ; send remote and local, kill and quit
- +1 KILL XMZ
- SET %DT="T"
- SET X="NOW"
- DO ^%DT
- SET YSCLNOW=$PIECE(Y,".",2)
- SET YSCLSITE=$PIECE($$SITE^VASITE,"^",2)
- +2 SET $PIECE(YSSTOP,",",7)=7
- IF $$S^%ZTLOAD
- DO ABORT^YSCLTEST
- GOTO END
- +3 SET YSDEBUG=$$GET1^DIQ(603.03,1,3,"I")
- SET YSPROD=$$GET1^DIQ(8989.3,1,501,"I")
- +4 ;S:YSPRODST="" YSPRODST="S.RUCLRXLAB@FO-HINES.DOMAIN.EXT"
- SET YSPRODST=$$GET1^DIQ(603.03,1,8)
- +5 ;S:YSDBGST="" YSDBGST="G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT"
- SET YSDBGST=$$GET1^DIQ(603.03,1,10)
- +6 ;/RBN - Begin modifications for YS*5.01*122
- +7 IF $GET(YSCLLN)
- Begin DoDot:1
- +8 KILL XMY
- +9 IF YSPROD
- Begin DoDot:2
- +10 ;XMY("G.CLOZAPINE ROLL-UP")="" ;,
- IF 'YSDEBUG
- SET XMY(YSPRODST)=""
- +11 IF '$TEST
- SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
- SET XMY("G.RUCLRXLAB@FO-DALLAS.DOMAIN.EXT")=""
- End DoDot:2
- +12 IF '$TEST
- Begin DoDot:2
- +13 IF 'YSDEBUG
- SET XMY(YSDBGST)=""
- +14 IF '$TEST
- SET XMY("G.CLOZAPINE DEBUG")=""
- End DoDot:2
- +15 SET XMDUZ="Clozapine MONITOR"
- SET XMTEXT="^TMP($J,"
- SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
- DO ^XMD
- End DoDot:1
- +16 KILL XMY
- +17 SET ^TMP("YSCL",$JOB,2,0)=" "
- SET ^TMP("YSCL",$JOB,3,0)="In message # "_$SELECT($DATA(XMZ):XMZ,1:"no data sent")
- +18 IF 'YSDEBUG
- SET XMY("G.PSOCLOZ")=""
- if YSPROD
- SET XMY("G.CLOZAPINE ROLL-UP@DOMAIN.EXT")=""
- +19 IF '$TEST
- SET XMY("G.CLOZAPINE DEBUG")=""
- if YSPROD
- SET XMY("G.CLOZAPINE DEBUG@FO-DALLAS.DOMAIN.EXT")=""
- +20 SET XMSUB=$SELECT(YSDEBUG:"DEBUG ",1:"")_"Clozapine lab data @ "_YSCLSITE_" on "_DT_" at "_YSCLNOW
- +21 KILL XMZ
- SET ^TMP("YSCL",$JOB,1,0)="Clozapine lab data was transmitted, "_YSCLLN_" records were sent"
- SET XMTEXT="^TMP(""YSCL"",$J,"
- DO ^XMD
- +22 ;S $P(^YSCL(603.03,1,0),"^",5)=$$NOW^XLFDT
- SET DIE="^YSCL(603.03,"
- SET DA=1
- SET DR="5////"_$$NOW^XLFDT
- DO ^DIE
- +23 ;/RBN - End modifications for YS*5.01*122
- END ;
- +1 GOTO END1^YSCLTST3
- +2 QUIT
- +3 ;
- REXMIT ; retransmit lab and RX data
- +1 ; must be a tuesday
- +2 SET DIR(0)="Y"
- SET DIR("A")="Are you sure you wish to retransmit lab data"
- +3 DO ^DIR
- KILL DIR
- IF Y'=1
- KILL Y
- QUIT
- +4 ;/RBN Begin modification for YS*122
- +5 DO REX^YSCLTST5
- +6 ;/RBN End modification for YS*122
- +7 QUIT
- +8 ;
- DATE SET %DT="AEXP"
- SET %DT(0)=-DT
- SET %DT("A")="Ending date for data collection."
- +1 DO ^%DT
- KILL %DT
- if X="^"
- GOTO END
- if X="^"
- GOTO END
- IF Y=-1
- GOTO DATE
- +2 ;/RBN Begin modifications for *122
- +3 SET ZTDESC="Server triggered retransmission"
- +4 SET ZTSAVE("YSCLED")=""
- SET ZTIO=""
- SET ZTRTN="REXMIT^YSCLTST5"
- SET ZTDTH=$HOROLOG
- +5 DO REXMIT^YSCLTST5
- GOTO END
- +6 ;/RBN End modifications for *122
- FLSET ;Set up file 603.02
- +1 WRITE @IOF,"This option specifies the blood tests associated with the Clozapine"
- +2 WRITE !,"reporting software. Two tests must be defined. The first is the White"
- +3 WRITE !,"Blood Count. The second is the Granulocyte (or Neutrophil) percentage."
- +4 KILL DIR
- WRITE !!
- SET DIR(0)="PA^64:EMZ"
- SET DIR("A",1)="Enter the test that will be used to record the White Blood Count for the"
- SET DIR("A")="Clozapine patients: "
- DO ^DIR
- +5 if Y=-1!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
- QUIT
- +6 SET YSCLWBC=+Y
- +7 KILL DIR
- WRITE !!
- SET DIR(0)="PA^64:EMZ"
- SET DIR("A",1)="Enter the test that will be used to record the Neutrophil Count (percentage)"
- SET DIR("A")=" for the Clozapine patients: "
- DO ^DIR
- +8 if Y=-1!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIRUT))!($DATA(DIROUT))
- QUIT
- +9 SET YSCLGRN=+Y
- +10 IF YSCLWBC
- IF YSCLGRN
- Begin DoDot:1
- +11 ;YS193 - add SET of DIC(0) in next line
- +12 KILL DD
- SET DIC="^YSCL(603.02,"
- SET DIC(0)=""
- SET X=YSCLWBC
- SET DIC("DR")="1////"_YSCLGRN
- KILL DO
- DO FILE^DICN
- End DoDot:1
- +13 ;Only one entry is allowed.
- +14 KILL DIR,X,Y,YSCLWBC,YSCLGRN,ZTDESC
- +15 QUIT
- EN(DRG) ;
- +1 KILL LAB
- +2 IF $$GET1^DIQ(50,DRG,17.5)'="PSOCLO1"
- SET LAB("NOT")=0
- QUIT
- +3 NEW YSARRAY
- DO LIST^DIC(50.02,","_YSDRG_",",3,"I",,,,,,,"YSARRAY")
- +4 SET (CNT,I)=0
- FOR
- SET I=$ORDER(YSARRAY("DILIST",2,I))
- if 'I
- QUIT
- SET CNT=$GET(CNT)+1
- +5 IF CNT'=2
- SET LAB("BAD TEST")=0
- KILL CNT
- QUIT
- +6 KILL CNT
- FOR I=1:1
- if '$DATA(YSARRAY("DILIST","ID",I))
- QUIT
- Begin DoDot:1
- +7 SET LABT=$SELECT(YSARRAY("DILIST","ID",I,3)=1:"WBC",1:"ANC")
- SET YSLN=YSARRAY("DILIST",2,I)
- +8 SET LAB(LABT)=$$GET1^DIQ(50.02,YSLN_","_DRG,.01,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,2,"I")_"^"_$$GET1^DIQ(50.02,YSLN_","_DRG,3,"I")
- End DoDot:1
- +9 KILL LABT,I
- +10 QUIT
- CL1(DFN,DAYS) ;The routine was split due to size
- +1 GOTO CL1^YSCLTST4
- +2 QUIT
- +3 ;
- +4 ;BEGIN: JCH - PSO*7*612
- CL(DFN,PSORCLOZ) ; patient must be in both file #55 and #603.01 to get lab results
- +1 ;END: JCH - PSO*7*612
- +2 KILL ^TMP("LRRR",$JOB)
- NEW RESULTS,YSCLYWBC,YSCLRANC,YSCLYANC,YSCLXANC,YSCLXWBC,YSCLRWBC,YSCLFRQ,YSCLIEN
- +3 IF 'DFN
- QUIT "-1^-1^-1^-1^-1^-1^-1"
- +4 NEW ARRAY
- DO LIST^DIC(603.01,,1,"I",,,DFN,"C",,,"ARRAY")
- +5 IF '$DATA(ARRAY("DILIST","ID"))
- QUIT "-1^-1^-1^-1^-1^-1^-1"
- +6 ;BEGIN: JCH - YS*5.01*166 Use frequency from registered cloz auth number, otherwise most recently assigned cloz number
- +7 SET YSCLIEN=$$GETREGYS^PSOCLUTL(DFN)
- SET YSCLFRQ=""
- +8 IF YSCLIEN>0
- SET YSCLIEN=$ORDER(^YSCL(603.01,"C",DFN,""),-1)
- +9 ;END: JCH - YS*5.01*166
- +10 IF YSCLIEN
- SET YSCLFRQ=$$GET1^DIQ(603.01,YSCLIEN,2,"I")
- +11 IF $$GET1^DIQ(603.03,1,7,"I")=1!(YSCLFRQ="")
- QUIT "-1^0^0^0^0^0^"_YSCLFRQ
- +12 IF $$GET1^DIQ(55,DFN,54,"I")'="A"
- QUIT "-1^0^0^0^0^0^"_YSCLFRQ
- +13 ; BEGIN: JCH - PSO*7*612. If coming from CPRS, no cloz ordering if local override number currently registered
- +14 IF $GET(PSORCLOZ)
- NEW ORYSIEN
- SET ORYSIEN=$$GET1^DIQ(603.01,YSCLIEN,.01,"I")
- IF ORYSIEN?1U6N
- QUIT "-1^0^0^0^0^0"
- +15 ; END: JCH - PSO*7*612
- +16 ; YS*5.01*227 - Change default to new field in parameters file
- SET X1=DT
- SET X2=$$GET1^DIQ(603.03,"1,",12)
- DO C^%DTC
- SET YSCLSD=X
- +17 KILL ARRAY
- DO LIST^DIC(603.41,",1,",,"I",,,,,,,"ARRAY")
- +18 FOR I=1:1
- if '$DATA(ARRAY("DILIST",2,I))
- QUIT
- SET YSCLA=ARRAY("DILIST",2,I)
- Begin DoDot:1
- +19 NEW YSCLTNM,YSCLTTP,YSCLTFR
- SET YSCLTNM=$$GET1^DIQ(603.41,YSCLA_",1,",.01,"I")
- +20 SET YSCLTTP=$$GET1^DIQ(603.41,YSCLA_",1,",1,"I")
- +21 SET YSCLTFR=$$GET1^DIQ(603.41,YSCLA_",1,",2,"I")
- +22 SET YSCLTLS(YSCLTTP,YSCLTNM)=YSCLTFR
- End DoDot:1
- +23 FOR I=1:1
- if '$DATA(ARRAY("DILIST",1,I))
- QUIT
- SET YSCLTL=ARRAY("DILIST",1,I)
- Begin DoDot:1
- +24 DO RR^LR7OR1(DFN,,YSCLSD,DT,,YSCLTL,"L")
- +25 SET YSCLSB1=""
- FOR
- SET YSCLSB1=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1))
- if YSCLSB1=""
- QUIT
- Begin DoDot:2
- +26 ;YS*5.01*227 - No longer excluding dates without times
- SET YSCLTDT=""
- FOR
- SET YSCLTDT=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT))
- if YSCLTDT=""
- QUIT
- Begin DoDot:3
- +27 SET YSCLTA=""
- FOR
- SET YSCLTA=$ORDER(^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA))
- if YSCLTA=""
- QUIT
- IF YSCLTA
- Begin DoDot:4
- +28 SET RESULTS1=^TMP("LRRR",$JOB,DFN,YSCLSB1,YSCLTDT,YSCLTA)
- +29 SET RESULTS(YSCLTL,YSCLTDT)=$PIECE(RESULTS1,"^",2)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +30 ;Find all entries for WBC and sort by inverse date.
- +31 SET YSCLA=""
- FOR
- SET YSCLA=$ORDER(YSCLTLS("W",YSCLA))
- if 'YSCLA
- QUIT
- SET YSCLXWBC(YSCLA)=""
- Begin DoDot:1
- +32 SET YSCLA1=""
- FOR
- SET YSCLA1=$ORDER(RESULTS(YSCLA,YSCLA1))
- if 'YSCLA1
- QUIT
- SET YSCLYWBC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("W",YSCLA)
- End DoDot:1
- +33 IF '$DATA(YSCLYWBC)
- GOTO ALTANC
- +34 IF $DATA(YSCLXWBC)
- IF $DATA(YSCLYWBC)
- Begin DoDot:1
- +35 ;D KILL Q "0^^^^^^"_YSCLFRQ
- SET YSCLRWBC=$ORDER(YSCLYWBC(0))
- IF 'YSCLRWBC
- +36 SET YSCLMULT=$PIECE(YSCLYWBC(YSCLRWBC),"^",3)
- SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
- +37 SET YSCLRWBC(YSCLRWBC)=($PIECE(YSCLYWBC(YSCLRWBC),"^")*YSCLMULT)_"^"_$PIECE(YSCLYWBC(YSCLRWBC),"^",2)
- +38 ;Scan for Neutrophil count on same day and time as most recent WBC
- +39 SET YSCLMTCH=0
- FOR YSCLA="A","N","S","T"
- SET YSCLTPT=""
- if YSCLMTCH
- QUIT
- FOR
- SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
- if 'YSCLTPT
- QUIT
- Begin DoDot:2
- +40 SET YSCLMULT=YSCLTLS(YSCLA,YSCLTPT)
- SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
- +41 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="A"
- IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
- SET YSCLMTCH=1
- SET YSCLRANC(YSCLRWBC)=RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
- QUIT
- +42 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="N"
- IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
- SET YSCLMTCH=1
- SET YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
- QUIT
- +43 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="S"
- IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
- Begin DoDot:3
- +44 SET YSCLSGS=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
- Begin DoDot:4
- +45 if 'YSCLSGS
- SET YSCLSGS="Z"
- IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
- SET RESULTS(YSCLSGS,YSCLRWBC)=0
- +46 SET YSCLMTCH=1
- SET YSCLRANC(YSCLRWBC)=YSCLRWBC(YSCLRWBC)*((RESULTS(YSCLTPT,YSCLRWBC)*.01)+(RESULTS(YSCLSGS,YSCLRWBC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01)
- QUIT
- End DoDot:4
- if YSCLMTCH!'YSCLSGS
- QUIT
- End DoDot:3
- +47 IF $GET(RESULTS(YSCLTPT,YSCLRWBC))
- IF YSCLA="C"
- IF RESULTS(YSCLTPT,YSCLRWBC)'?1A.E
- Begin DoDot:3
- +48 SET YSCLSGS=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
- Begin DoDot:4
- +49 if 'YSCLSGS
- SET YSCLSGS="Z"
- IF '$DATA(RESULTS(YSCLSGS,YSCLRWBC))
- SET RESULTS(YSCLSGS,YSCLRWBC)=0
- +50 SET YSCLMTCH=1
- SET YSCLRANC(YSCLRWBC)=((RESULTS(YSCLTPT,YSCLRWBC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRWBC)*YSCLMULT))_"^"_$PIECE(^LAB(60,YSCLTPT,0),"^")_"/"_$PIECE($GET(^LAB(60,YSCLSGS,0)),"^")
- QUIT
- End DoDot:4
- if YSCLMTCH!'YSCLSGS
- QUIT
- End DoDot:3
- End DoDot:2
- if YSCLMTCH
- QUIT
- End DoDot:1
- +51 DO KILL
- +52 IF '$GET(YSCLRWBC(YSCLRWBC))
- IF '+$GET(YSCLRANC(YSCLRWBC))
- QUIT "0^^^^^^"_YSCLFRQ
- +53 IF $GET(YSCLRWBC(YSCLRWBC))
- IF +$GET(YSCLRANC(YSCLRWBC))<1000
- QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +54 IF '$GET(YSCLRWBC(YSCLRWBC))
- IF +$GET(YSCLRANC(YSCLRWBC))<1000
- QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +55 ;I '$G(YSCLRWBC(YSCLRWBC)),+$G(YSCLRANC(YSCLRWBC)) Q "0^"_$G(YSCLRWBC(YSCLRWBC))_"^"_$S($G(YSCLRANC(YSCLRWBC))="":"^",1:$G(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ ; PWT - YS*5.01*227
- +56 IF $GET(YSCLRWBC(YSCLRWBC))
- IF +$GET(YSCLRANC(YSCLRWBC))<1500
- QUIT "2^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +57 ;;END NCC REMEDIATION << RJS*122
- +58 QUIT "1^"_YSCLRWBC(YSCLRWBC)_"^"_YSCLRANC(YSCLRWBC)_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +59 ;
- +60 ;;START NCC REMEDIATION >> RJS*122
- ALTANC ;
- +1 SET YSCLA=0
- FOR
- SET YSCLA=$ORDER(YSCLTLS("A",YSCLA))
- if 'YSCLA
- QUIT
- SET YSCLXANC(YSCLA)=""
- Begin DoDot:1
- +2 SET YSCLA1=0
- FOR
- SET YSCLA1=$ORDER(RESULTS(YSCLA,YSCLA1))
- if 'YSCLA1
- QUIT
- SET YSCLYANC(YSCLA1)=RESULTS(YSCLA,YSCLA1)_"^"_$$GET1^DIQ(60,YSCLA,.01)_"^"_YSCLTLS("A",YSCLA)
- End DoDot:1
- +3 IF $DATA(YSCLYANC)
- Begin DoDot:1
- +4 ;D KILL Q "0^^^^^^"_YSCLFRQ
- SET (YSCLRANC,YSCLRWBC)=$ORDER(YSCLYANC(0))
- IF 'YSCLRANC
- +5 SET YSCLMULT=$PIECE(YSCLYANC(YSCLRANC),"^",3)
- SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
- +6 SET YSCLRANC(YSCLRANC)=($PIECE(YSCLYANC(YSCLRANC),"^")*YSCLMULT)_"^"_$PIECE(YSCLYANC(YSCLRANC),"^",2)
- +7 ;Scan for Neutrophil count on same day and time as most recent ANC
- +8 SET YSCLMTCH=0
- FOR YSCLA="A","N","S","T"
- SET YSCLTPT=""
- if YSCLMTCH
- QUIT
- FOR
- SET YSCLTPT=$ORDER(YSCLTLS(YSCLA,YSCLTPT))
- if 'YSCLTPT
- QUIT
- Begin DoDot:2
- +9 SET YSCLMULT=YSCLTLS(YSCLA,YSCLTPT)
- SET YSCLMULT=$SELECT(YSCLMULT:1000,1:1)
- +10 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
- IF YSCLA="A"
- IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
- SET YSCLMTCH=1
- SET YSCLRANC(YSCLRANC)=RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
- QUIT
- +11 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
- IF YSCLA="N"
- IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
- SET YSCLMTCH=1
- SET YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC))*.01)_"^"_$$GET1^DIQ(60,YSCLTPT,.01)
- QUIT
- +12 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
- IF YSCLA="S"
- IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
- Begin DoDot:3
- +13 SET YSCLSGS=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("B",YSCLSGS))
- Begin DoDot:4
- +14 if 'YSCLSGS
- SET YSCLSGS="Z"
- IF '$DATA(RESULTS(YSCLSGS,YSCLRANC))
- SET RESULTS(YSCLSGS,YSCLRANC)=0
- +15 SET YSCLMTCH=1
- SET YSCLRANC(YSCLRANC)=YSCLRANC(YSCLRANC)*((RESULTS(YSCLTPT,YSCLRANC)*.01)+(RESULTS(YSCLSGS,YSCLRANC)*.01))_"^"_$$GET1^DIQ(60,YSCLTPT,.01)_"/"_$$GET1^DIQ(60,YSCLSGS,.01)
- QUIT
- End DoDot:4
- if YSCLMTCH
- QUIT
- End DoDot:3
- +16 IF $DATA(RESULTS(YSCLTPT,YSCLRANC))
- IF YSCLA="C"
- IF RESULTS(YSCLTPT,YSCLRANC)'?1A.E
- Begin DoDot:3
- +17 SET YSCLSGS=""
- FOR
- SET YSCLSGS=$ORDER(YSCLTLS("T",YSCLSGS))
- Begin DoDot:4
- +18 if 'YSCLSGS
- SET YSCLSGS="Z"
- IF '$DATA(RESULTS(YSCLSGS,YSCLRANC))
- SET RESULTS(YSCLSGS,YSCLRANC)=0
- +19 SET YSCLMTCH=1
- SET YSCLRANC(YSCLRANC)=((RESULTS(YSCLTPT,YSCLRANC)*YSCLMULT)+(RESULTS(YSCLSGS,YSCLRANC)*YSCLMULT))_"^"_$PIECE(^LAB(60,YSCLTPT,0),"^")_"/"_$PIECE($GET(^LAB(60,YSCLSGS,0)),"^")
- QUIT
- End DoDot:4
- if YSCLMTCH
- QUIT
- End DoDot:3
- End DoDot:2
- if YSCLMTCH
- QUIT
- +20 SET YSCLRWBC(YSCLRWBC)="^WBC"
- End DoDot:1
- +21 DO KILL
- +22 IF '$GET(YSCLRANC(+$GET(YSCLRWBC)))
- QUIT "0^^^^^^"_YSCLFRQ
- +23 IF +$GET(YSCLRANC(YSCLRWBC))<1000
- QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +24 IF +$GET(YSCLRANC(YSCLRWBC))<1500
- QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +25 QUIT "0^"_$GET(YSCLRWBC(YSCLRWBC))_"^"_$SELECT($GET(YSCLRANC(YSCLRWBC))="":"^",1:$GET(YSCLRANC(YSCLRWBC)))_"^"_(9999999-YSCLRWBC)_"^"_YSCLFRQ
- +26 ;;END NCC REMEDIATION << RJS*122
- +27 ;
- KILL ;
- +1 ;Q:$D(PSLAST7) ;RTW
- +2 KILL FDA,YSCLSGS,Y15,RESULTS,RESULTS1,YSCLA,YSCLA1,YSCLMTCH,YSCLSB1,YSCLSD,YSCLTA,YSCLMULT
- +3 KILL YSCLTL,YSCLTLS,X1,X2
- +4 ; YS*5.01*227 - Clean up ^TMP
- KILL ^TMP("LRRR",$JOB)
- +5 QUIT
- +6 ;
- OVERRIDE(DFN) ;Check for an over-ride. SEE RQ12.11
- +1 ;S YSCLIEN=$O(^YSCL(603.01,"C",DFN,0)) Q:YSCLIEN="" 0
- NEW YSCLIEN,YSCLOVRD,ARRAY
- +2 ;BEGIN: JCH - YS*5.01*166
- +3 NEW YSCLPSN,PSOCZPTS,PSOERR,Y,X
- +4 ; Get current Clozapine number associated with patient's Clozapine registration
- DO GET55(DFN,.YSCLPSN)
- SET YSCLPSN=$GET(YSCLPSN(DFN,53))
- if YSCLPSN=""
- QUIT 0
- +5 DO FIND^DIC(603.01,"","","QX",DFN,"","C","I $P($G(^(0)),""^"")=$G(YSCLPSN)","","PSOCZPTS","PSOERR")
- +6 SET YSCLIEN=$GET(PSOCZPTS("DILIST",2,1))
- if YSCLPSN=""
- QUIT 0
- +7 ;END: JCH - YS*5.01*166
- +8 SET YSCLOVRD=$$GET1^DIQ(603.01,YSCLIEN,3,"I")
- +9 if YSCLOVRD'=DT
- SET ANQRE=""
- +10 IF '$GET(PSGCFLG)
- IF $GET(YSCLOVRD)
- IF DT>YSCLOVRD
- SET X=YSCLOVRD
- SET YSCXDATE=$$FMTE^XLFDT(X,"D")
- WRITE !,"National Override expired at midnight on "_YSCXDATE
- +11 QUIT YSCLOVRD=DT
- ZEOR ;YSCLTST2
- +1 QUIT
- +2 ;
- GET55(DFN,CLOZ55) ; JCH - PSO*7*612 - Get Clozapine "SAND" node from file 55 via PDM API
- +1 if '$GET(DFN)
- QUIT ""
- +2 KILL CLOZ55
- +3 DO PSS^PSS781(+DFN,"","SAND")
- +4 MERGE CLOZ55(DFN)=^TMP($JOB,"SAND",DFN)
- +5 QUIT