- PSS160EN ;BIR/RTR-Environment check routine for patch PSS*1*160 ;02/18/11
- ;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
- ;
- Q:'$G(XPDENV)
- ;
- ;
- EN ;Check to see if all Local Med Routes are mapped and Local Possible Dosages are completed
- N PSSMRMFM,PSSMRMLP,PSSMRMNM,PSSMRMFD,PSSMRMAR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DLAYGO
- N PSSMRMCT,PSSMRMXX,PSSMRMIN,PSSMRMZR,PSSMRMN1,PSSMRMN3,PSSMRMOK,PSSMRM22,PSSMRMBB,PSSMRMT1,PSSMRMD1,PSSMRMD2,PSSMRMTC
- ;
- ;
- S (PSSMRMFM,PSSMRMFD)=0
- ;Med Route check, using PSSMRMFM as flag
- D BMES^XPDUTL("Checking for any remaining unmapped Local Medication Routes...")
- S PSSMRMNM="" F S PSSMRMNM=$O(^PS(51.2,"B",PSSMRMNM)) Q:PSSMRMNM=""!(PSSMRMFM) D
- .F PSSMRMLP=0:0 S PSSMRMLP=$O(^PS(51.2,"B",PSSMRMNM,PSSMRMLP)) Q:'PSSMRMLP!(PSSMRMFM) D
- ..I '$P($G(^PS(51.2,PSSMRMLP,0)),"^",4) Q
- ..I '$P($G(^PS(51.2,PSSMRMLP,1)),"^") S PSSMRMFM=1
- I 'PSSMRMFM D BMES^XPDUTL("All Local Medication Routes have been mapped!!") G DOS
- K PSSMRMAR
- S PSSMRMAR(1)=" "
- S PSSMRMAR(2)="There are still local Medication Routes marked for 'ALL PACKAGES' not yet"
- S PSSMRMAR(3)="mapped. Any orders containing an unmapped medication route will not have"
- S PSSMRMAR(4)="dosage checks performed. Please refer to the 'Medication Route Mapping Report'"
- S PSSMRMAR(5)="option for more details."
- S PSSMRMAR(6)=" "
- D MES^XPDUTL(.PSSMRMAR) K PSSMRMAR
- ;
- ;
- DOS ;Check to see if all Local Possible Dosages are mapped
- ;Local Possible Dosage check, using PSSMRMFD as flag
- D BMES^XPDUTL("Checking for any remaining Local Possible Dosages missing data...")
- ;
- S (PSSMRMFD,PSSMRMCT)=0
- S PSSMRMXX="" F S PSSMRMXX=$O(^PSDRUG("B",PSSMRMXX)) Q:PSSMRMXX=""!(PSSMRMFD) F PSSMRMIN=0:0 S PSSMRMIN=$O(^PSDRUG("B",PSSMRMXX,PSSMRMIN)) Q:'PSSMRMIN!(PSSMRMFD) D
- .K PSSMRMZR,PSSMRMN1,PSSMRMN3
- .S PSSMRMZR=$G(^PSDRUG(PSSMRMIN,0)),PSSMRMN1=$P($G(^PSDRUG(PSSMRMIN,"ND")),"^"),PSSMRMN3=$P($G(^PSDRUG(PSSMRMIN,"ND")),"^",3)
- .S PSSMRMCT=PSSMRMCT+1 I '(PSSMRMCT#2000) D BMES^XPDUTL("...Still checking Local Possible Dosages...")
- .S PSSMRMOK=$$TEST
- .Q:'PSSMRMOK
- .S PSSMRM22=0 F PSSMRMBB=0:0 S PSSMRMBB=$O(^PSDRUG(PSSMRMIN,"DOS2",PSSMRMBB)) Q:'PSSMRMBB!(PSSMRM22) S PSSMRMT1=$G(^PSDRUG(PSSMRMIN,"DOS2",PSSMRMBB,0)) I $P(PSSMRMT1,"^")'="" I '$P(PSSMRMT1,"^",5)!($P(PSSMRMT1,"^",6)="") S PSSMRM22=1
- .Q:'PSSMRM22
- .S PSSMRMFD=1
- I 'PSSMRMFD D BMES^XPDUTL("Population of data for eligible Local Possible Dosages has been completed!!") D BMES^XPDUTL(" ") G PRC
- K PSSMRMAR
- S PSSMRMAR(1)=" "
- S PSSMRMAR(2)="There are still local possible dosages eligible for dosage checks that have"
- S PSSMRMAR(3)="missing data in the Numeric Dose and Dose Unit fields. Any orders containing"
- S PSSMRMAR(4)="such local possible dosages may not have dosage checks performed. Please"
- S PSSMRMAR(5)="refer to the 'Local Possible Dosages Report' option for more details."
- S PSSMRMAR(6)=" "
- D MES^XPDUTL(.PSSMRMAR) K PSSMRMAR
- ;
- ;
- PRC ;Ask to continue
- I 'PSSMRMFM,'PSSMRMFD G MAIL
- K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to continue to install this patch" D ^DIR
- I Y'=1!($D(DUOUT))!($D(DTOUT)) S XPDABORT=2 Q
- K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- ;
- ;
- MAIL ;set up mail recipients for Post Init
- D REC
- S @XPDGREF@("PSSMLMSG",1)="Installation of Patch PSS*1.0*160 has been completed!"
- S @XPDGREF@("PSSMLMSG",2)=" "
- S PSSMRMTC=3
- I 'PSSMRMFM S @XPDGREF@("PSSMLMSG",PSSMRMTC)="All Local Medication Routes have been mapped!!" G LMESS
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="There are still local Medication Routes marked for 'ALL PACKAGES' not yet" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="mapped. Any orders containing an unmapped medication route will not have" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="dosage checks performed. Please refer to the 'Medication Route Mapping Report'" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="option for more details."
- ;
- ;
- LMESS ;
- D INC I 'PSSMRMFD S @XPDGREF@("PSSMLMSG",PSSMRMTC)="Population of data for eligible Local Possible Dosages has been completed!!" D INC Q
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="There are still local possible dosages eligible for dosage checks that have" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="missing data in the Numeric Dose and Dose Unit fields. Any orders containing" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="such local possible dosages may not have dosage checks performed. Please" S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)="refer to the 'Local Possible Dosages Report' option for more details." D INC
- Q
- ;
- ;
- TEST() ;See if drug need Dose Unit and Numeric Dose defined
- I 'PSSMRMN3!('PSSMRMN1) Q 0
- I $P($G(^PSDRUG(PSSMRMIN,"I")),"^"),$P($G(^PSDRUG(PSSMRMIN,"I")),"^")<DT Q 0
- I '$O(^PSDRUG(PSSMRMIN,"DOS2",0)) Q 0
- I $P(PSSMRMZR,"^",3)["S"!($E($P(PSSMRMZR,"^",2),1,2)="XA") Q 0
- N PSSMRMVV
- S PSSMRMVV=""
- I PSSMRMN1,PSSMRMN3,$T(OVRIDE^PSNAPIS)]"" S PSSMRMVV=$$OVRIDE^PSNAPIS(PSSMRMN1,PSSMRMN3)
- K PSSMRMD1,PSSMRMD2
- I PSSMRMN1,PSSMRMN3 S PSSMRMD1=$$DFSU^PSNAPIS(PSSMRMN1,PSSMRMN3) S PSSMRMD2=$P(PSSMRMD1,"^")
- I $G(PSSMRMD2)'>0,$P($G(^PSDRUG(PSSMRMIN,2)),"^") S PSSMRMD2=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSMRMIN,2)),"^"),0)),"^",2)
- I PSSMRMVV=""!('$G(PSSMRMD2))!($P($G(^PS(50.606,+$G(PSSMRMD2),1)),"^")="") Q 1
- I $P($G(^PS(50.606,+$G(PSSMRMD2),1)),"^"),'PSSMRMVV Q 0
- I '$P($G(^PS(50.606,+$G(PSSMRMD2),1)),"^"),PSSMRMVV Q 0
- Q 1
- ;
- ;
- REC ;Set up mail message recipients
- S @XPDGREF@("PSSMLMDZ",DUZ)=""
- S @XPDGREF@("PSSMLMDZ","G.PSS ORDER CHECKS")=""
- Q
- ;
- ;
- PRMP ;
- K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR
- K DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- Q
- ;
- ;
- INC ;
- S PSSMRMTC=PSSMRMTC+1
- S @XPDGREF@("PSSMLMSG",PSSMRMTC)=" "
- S PSSMRMTC=PSSMRMTC+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS160EN 5914 printed Feb 18, 2025@23:55:16 Page 2
- PSS160EN ;BIR/RTR-Environment check routine for patch PSS*1*160 ;02/18/11
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**160**;9/30/97;Build 76
- +2 ;
- +3 if '$GET(XPDENV)
- QUIT
- +4 ;
- +5 ;
- EN ;Check to see if all Local Med Routes are mapped and Local Possible Dosages are completed
- +1 NEW PSSMRMFM,PSSMRMLP,PSSMRMNM,PSSMRMFD,PSSMRMAR,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DLAYGO
- +2 NEW PSSMRMCT,PSSMRMXX,PSSMRMIN,PSSMRMZR,PSSMRMN1,PSSMRMN3,PSSMRMOK,PSSMRM22,PSSMRMBB,PSSMRMT1,PSSMRMD1,PSSMRMD2,PSSMRMTC
- +3 ;
- +4 ;
- +5 SET (PSSMRMFM,PSSMRMFD)=0
- +6 ;Med Route check, using PSSMRMFM as flag
- +7 DO BMES^XPDUTL("Checking for any remaining unmapped Local Medication Routes...")
- +8 SET PSSMRMNM=""
- FOR
- SET PSSMRMNM=$ORDER(^PS(51.2,"B",PSSMRMNM))
- if PSSMRMNM=""!(PSSMRMFM)
- QUIT
- Begin DoDot:1
- +9 FOR PSSMRMLP=0:0
- SET PSSMRMLP=$ORDER(^PS(51.2,"B",PSSMRMNM,PSSMRMLP))
- if 'PSSMRMLP!(PSSMRMFM)
- QUIT
- Begin DoDot:2
- +10 IF '$PIECE($GET(^PS(51.2,PSSMRMLP,0)),"^",4)
- QUIT
- +11 IF '$PIECE($GET(^PS(51.2,PSSMRMLP,1)),"^")
- SET PSSMRMFM=1
- End DoDot:2
- End DoDot:1
- +12 IF 'PSSMRMFM
- DO BMES^XPDUTL("All Local Medication Routes have been mapped!!")
- GOTO DOS
- +13 KILL PSSMRMAR
- +14 SET PSSMRMAR(1)=" "
- +15 SET PSSMRMAR(2)="There are still local Medication Routes marked for 'ALL PACKAGES' not yet"
- +16 SET PSSMRMAR(3)="mapped. Any orders containing an unmapped medication route will not have"
- +17 SET PSSMRMAR(4)="dosage checks performed. Please refer to the 'Medication Route Mapping Report'"
- +18 SET PSSMRMAR(5)="option for more details."
- +19 SET PSSMRMAR(6)=" "
- +20 DO MES^XPDUTL(.PSSMRMAR)
- KILL PSSMRMAR
- +21 ;
- +22 ;
- DOS ;Check to see if all Local Possible Dosages are mapped
- +1 ;Local Possible Dosage check, using PSSMRMFD as flag
- +2 DO BMES^XPDUTL("Checking for any remaining Local Possible Dosages missing data...")
- +3 ;
- +4 SET (PSSMRMFD,PSSMRMCT)=0
- +5 SET PSSMRMXX=""
- FOR
- SET PSSMRMXX=$ORDER(^PSDRUG("B",PSSMRMXX))
- if PSSMRMXX=""!(PSSMRMFD)
- QUIT
- FOR PSSMRMIN=0:0
- SET PSSMRMIN=$ORDER(^PSDRUG("B",PSSMRMXX,PSSMRMIN))
- if 'PSSMRMIN!(PSSMRMFD)
- QUIT
- Begin DoDot:1
- +6 KILL PSSMRMZR,PSSMRMN1,PSSMRMN3
- +7 SET PSSMRMZR=$GET(^PSDRUG(PSSMRMIN,0))
- SET PSSMRMN1=$PIECE($GET(^PSDRUG(PSSMRMIN,"ND")),"^")
- SET PSSMRMN3=$PIECE($GET(^PSDRUG(PSSMRMIN,"ND")),"^",3)
- +8 SET PSSMRMCT=PSSMRMCT+1
- IF '(PSSMRMCT#2000)
- DO BMES^XPDUTL("...Still checking Local Possible Dosages...")
- +9 SET PSSMRMOK=$$TEST
- +10 if 'PSSMRMOK
- QUIT
- +11 SET PSSMRM22=0
- FOR PSSMRMBB=0:0
- SET PSSMRMBB=$ORDER(^PSDRUG(PSSMRMIN,"DOS2",PSSMRMBB))
- if 'PSSMRMBB!(PSSMRM22)
- QUIT
- SET PSSMRMT1=$GET(^PSDRUG(PSSMRMIN,"DOS2",PSSMRMBB,0))
- IF $PIECE(PSSMRMT1,"^")'=""
- IF '$PIECE(PSSMRMT1,"^",5)!($PIECE(PSSMRMT1,"^",6)="")
- SET PSSMRM22=1
- +12 if 'PSSMRM22
- QUIT
- +13 SET PSSMRMFD=1
- End DoDot:1
- +14 IF 'PSSMRMFD
- DO BMES^XPDUTL("Population of data for eligible Local Possible Dosages has been completed!!")
- DO BMES^XPDUTL(" ")
- GOTO PRC
- +15 KILL PSSMRMAR
- +16 SET PSSMRMAR(1)=" "
- +17 SET PSSMRMAR(2)="There are still local possible dosages eligible for dosage checks that have"
- +18 SET PSSMRMAR(3)="missing data in the Numeric Dose and Dose Unit fields. Any orders containing"
- +19 SET PSSMRMAR(4)="such local possible dosages may not have dosage checks performed. Please"
- +20 SET PSSMRMAR(5)="refer to the 'Local Possible Dosages Report' option for more details."
- +21 SET PSSMRMAR(6)=" "
- +22 DO MES^XPDUTL(.PSSMRMAR)
- KILL PSSMRMAR
- +23 ;
- +24 ;
- PRC ;Ask to continue
- +1 IF 'PSSMRMFM
- IF 'PSSMRMFD
- GOTO MAIL
- +2 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +3 SET DIR(0)="Y"
- SET DIR("B")="Y"
- SET DIR("A")="Do you want to continue to install this patch"
- DO ^DIR
- +4 IF Y'=1!($DATA(DUOUT))!($DATA(DTOUT))
- SET XPDABORT=2
- QUIT
- +5 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +6 ;
- +7 ;
- MAIL ;set up mail recipients for Post Init
- +1 DO REC
- +2 SET @XPDGREF@("PSSMLMSG",1)="Installation of Patch PSS*1.0*160 has been completed!"
- +3 SET @XPDGREF@("PSSMLMSG",2)=" "
- +4 SET PSSMRMTC=3
- +5 IF 'PSSMRMFM
- SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="All Local Medication Routes have been mapped!!"
- GOTO LMESS
- +6 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="There are still local Medication Routes marked for 'ALL PACKAGES' not yet"
- SET PSSMRMTC=PSSMRMTC+1
- +7 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="mapped. Any orders containing an unmapped medication route will not have"
- SET PSSMRMTC=PSSMRMTC+1
- +8 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="dosage checks performed. Please refer to the 'Medication Route Mapping Report'"
- SET PSSMRMTC=PSSMRMTC+1
- +9 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="option for more details."
- +10 ;
- +11 ;
- LMESS ;
- +1 DO INC
- IF 'PSSMRMFD
- SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="Population of data for eligible Local Possible Dosages has been completed!!"
- DO INC
- QUIT
- +2 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="There are still local possible dosages eligible for dosage checks that have"
- SET PSSMRMTC=PSSMRMTC+1
- +3 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="missing data in the Numeric Dose and Dose Unit fields. Any orders containing"
- SET PSSMRMTC=PSSMRMTC+1
- +4 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="such local possible dosages may not have dosage checks performed. Please"
- SET PSSMRMTC=PSSMRMTC+1
- +5 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)="refer to the 'Local Possible Dosages Report' option for more details."
- DO INC
- +6 QUIT
- +7 ;
- +8 ;
- TEST() ;See if drug need Dose Unit and Numeric Dose defined
- +1 IF 'PSSMRMN3!('PSSMRMN1)
- QUIT 0
- +2 IF $PIECE($GET(^PSDRUG(PSSMRMIN,"I")),"^")
- IF $PIECE($GET(^PSDRUG(PSSMRMIN,"I")),"^")<DT
- QUIT 0
- +3 IF '$ORDER(^PSDRUG(PSSMRMIN,"DOS2",0))
- QUIT 0
- +4 IF $PIECE(PSSMRMZR,"^",3)["S"!($EXTRACT($PIECE(PSSMRMZR,"^",2),1,2)="XA")
- QUIT 0
- +5 NEW PSSMRMVV
- +6 SET PSSMRMVV=""
- +7 IF PSSMRMN1
- IF PSSMRMN3
- IF $TEXT(OVRIDE^PSNAPIS)]""
- SET PSSMRMVV=$$OVRIDE^PSNAPIS(PSSMRMN1,PSSMRMN3)
- +8 KILL PSSMRMD1,PSSMRMD2
- +9 IF PSSMRMN1
- IF PSSMRMN3
- SET PSSMRMD1=$$DFSU^PSNAPIS(PSSMRMN1,PSSMRMN3)
- SET PSSMRMD2=$PIECE(PSSMRMD1,"^")
- +10 IF $GET(PSSMRMD2)'>0
- IF $PIECE($GET(^PSDRUG(PSSMRMIN,2)),"^")
- SET PSSMRMD2=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSMRMIN,2)),"^"),0)),"^",2)
- +11 IF PSSMRMVV=""!('$GET(PSSMRMD2))!($PIECE($GET(^PS(50.606,+$GET(PSSMRMD2),1)),"^")="")
- QUIT 1
- +12 IF $PIECE($GET(^PS(50.606,+$GET(PSSMRMD2),1)),"^")
- IF 'PSSMRMVV
- QUIT 0
- +13 IF '$PIECE($GET(^PS(50.606,+$GET(PSSMRMD2),1)),"^")
- IF PSSMRMVV
- QUIT 0
- +14 QUIT 1
- +15 ;
- +16 ;
- REC ;Set up mail message recipients
- +1 SET @XPDGREF@("PSSMLMDZ",DUZ)=""
- +2 SET @XPDGREF@("PSSMLMDZ","G.PSS ORDER CHECKS")=""
- +3 QUIT
- +4 ;
- +5 ;
- PRMP ;
- +1 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +2 SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- +3 KILL DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +4 QUIT
- +5 ;
- +6 ;
- INC ;
- +1 SET PSSMRMTC=PSSMRMTC+1
- +2 SET @XPDGREF@("PSSMLMSG",PSSMRMTC)=" "
- +3 SET PSSMRMTC=PSSMRMTC+1
- +4 QUIT