- PSGPLDP0 ;BIR/CML3-ENTER UNITS DISPENSED (PART 2) ;23 OCT 97 / 9:34 AM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- S PSGPLTND=^PS(53.5,PSGPLG,0),WSF=$P(PSGPLTND,"^",7)
- I $P(PSGPLTND,"^",2),'$P(PSGPLTND,"^",9) S PSGOD=$$ENDTC^PSGMI($P(PSGPLTND,"^",11)) W $C(7),$C(7),!!?33,"*** WARNING ***",!,"THIS PICK LIST STARTED TO RUN ",PSGOD,", BUT HAS NOT RUN TO COMPLETION."
- ;
- PRN ;
- F W !!,"Do you want to see PRN meds only" S %=2 D YN^DICN Q:% D PRNM^PSGPLDPH
- I %<0 S PRN="^" Q
- S PSGLCNT=0,PRN=%-1,(PC,TM)="" W @IOF
- ;
- TM ;
- S OK="" F S TM=$O(^PS(53.5,"AC",PSGPLG,TM)) Q:TM="" S WDN="" F S WDN=$O(^PS(53.5,"AC",PSGPLG,TM,WDN)) Q:WDN="" D:PRN&'WSF W1 S RB="" F S (PR,RB)=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB)) Q:RB="" S PN="" D PN G OUT:OK["^^^",TM:OK["^^"
- ;
- OUT ;
- W:'PRN&'PC !!?2,"(No PRN meds founds.)" F W !!,"ARE YOU FINISHED WITH THIS PICK LIST" S %=1 D YN^DICN Q:% D FMSG^PSGPLDPH
- Q:%<0 G:%'=1 PRN I $P(PSGPLTND,"^",3) D NOW^%DTC I $P(PSGPLTND,"^",3)>% Q
- ;
- FILE ;
- F W !!,"MAY I FILE THE DATA IN THIS PICK LIST AWAY" S %=2 D YN^DICN Q:% D FIMSG^PSGPLDPH
- I %=1 S DIE="^PS(53.5,",DA=PSGPLG,DR=".05////1" D ^DIE K DIE
- Q
- ;
- PN ;
- S OK="" F D Q:PN="" S PSGP=$P(PN,"^",2),WF=0 D:WSF&PRN W1 D:PRN W2 D ST Q:OK["^^" G:OK="^" PN
- .I ($E(OK,1,1)'="^")&($P(OK,"^",2)'?1.AP) S PN=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN)),OK="" Q
- .S DIC="^PS(53.5,"_PSGPLG_",1,",DIC(0)="EQZ",X=$P(OK,"^",2),OK="" D ^DIC K DIC I Y<0 S PN="" Q
- .S Y=$S(WSF:"zns",1:$P(Y(0),"^",3))
- .S RB=$P($G(^PS(53.5,PSGPLG,1,+Y(0),0)),U,4) I RB]"",$P(^PS(53.5,PSGPLG,0),U,6),RB'="zz" S RB=$S($P(RB,"-",2)?1N:0,1:"")_$P(RB,"-",2)_"-"_$P(RB,"-")
- .S RB=$S($P(^PS(53.5,PSGPLG,0),"^",8)=1:"zz",RB="":"zz",1:RB)
- .I '$D(^PS(53.5,"AC",PSGPLG,$P(Y(0),"^",2),Y,RB,$E($P($G(^DPT(+Y(0),0)),U),1,12)_U_+Y(0))) S PN="" K Y Q
- .S PN=$E($P($G(^DPT(+Y(0),0)),U),1,12)_U_+Y(0),TM=$P(Y(0),"^",2),WDN=Y K Y
- ;
- NP Q
- ;
- ST ;
- S ST="A" F S ST=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST)) Q:"Z"[ST D DRG Q:OK["^"
- Q
- ;
- DRG ;
- S DRG=""
- F S DRG=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG)) Q:DRG="" S PSGORD=$P(DRG,"^",2),PSJJORD=+$G(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,0)),SCH=$P($G(^PS(55,PSGP,5,PSJJORD,2)),"^") I SCH["PRN"!(ST="P")!PRN D GD Q:OK["^"
- Q
- ;
- GD ;
- S DDRG="" F Q:OK["^" S DDRG=$O(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG,DDRG)) Q:DDRG="" S DN=+$P(DDRG,"^",2),DN=$G(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,DN,0)),PDD=$P(DN,"^",3),PDN=$P(DN,"^",2) I DN'["DI" D
- .I DN="" W !,$$ENPDN^PSGMI(+$G(^PS(55,PSGP,5,PSJJORD,.2))),?42,"NEEDED: OI",?55,"DISPENSED:" D SCREEN Q
- .S DR=$P($G(^PS(55,PSGP,5,PSJJORD,1,+DN,0)),"^"),DR=$$ENDDN^PSGMI(DR)
- .S LMT=PDN*2+1000 I 'PRN S:'PC PC=1 I 'WF S WF=1,OK="??" D W1
- .I PDN="WS" W !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",PDN D SCREEN Q
- .S PSGLCNT=0
- .F W !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",$S(PDD="":"",1:PDD_"// ") R OK:DTIME W:'$T $C(7) S:'$T OK="^^^" Q:$S(OK=+OK:OK'>LMT,OK?1.3"^":1,($E(OK,1,1)="^")&($P(OK,"^",2)?1.AP):1,1:OK="") D:OK?1."?" GDMSG I OK'?1."?" W $C(7)," ??"
- .Q:($E(OK,1,1)="^")&($P(OK,"^",2)?1.AP)
- .I OK="" S OK=$S(PDD]"":PDD,PDN="NV":"",1:PDN) W " ",OK
- .I OK=+OK,OK'=PDD S $P(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,$P(DDRG,"^",2),0),"^",3)=OK
- Q
- ;
- GDMSG ;
- W !!," Enter the number of units actually dispensed for this medication. If the",!,"units dispensed is the same as the units needed (or units dispensed, if shown),",!,"just press the RETURN key."
- W " Enter an '^' to jump ahead to the next patient,",!,"'^^' to jump ahead to the next team, or '^^^' to exit this pick list.",! Q:OK'?2."?"
- ;
- W1 ;
- S PW=$S('WSF:WDN,1:$P(^PS(53.5,PSGPLG,1,PSGP,0),"^",3)),PSGLCNT=PSGLCNT+.5
- W !!,"TEAM: ",$S(TM'["zz":TM,1:"* N/F *"),?40,"WARD: ",$S(WDN'["zz":PW,1:"* N/F *") Q:OK'?2."?"
- ;
- W2 ;
- S PSSN=$S($D(^DPT(PSGP,0)):$E($P(^(0),"^",9),6,9),1:"* N/F *"),PPN=$S('$D(^(0)):PN,$P(^(0),"^")]"":$P(^(0),"^"),1:PN),PR=$P(^PS(53.5,PSGPLG,1,PSGP,0),"^",4)
- W !!,?5,$S($P(PSGPLTND,"^",8):"ROOM-BED: ",$P(PSGPLTND,"^",6):"BED-ROOM: ",1:"ROOM-BED: "),$S(PR'["zz":PR,1:"* N/F *"),?30,PPN," (",PSSN,")",!
- I '$D(^PS(53.5,PSGPLG,1,PSGP,1)) W !,?20,"(NO ORDERS)",! D SCREEN
- Q
- ;
- SCREEN ; display break
- S PSGLCNT=PSGLCNT+1 Q:PSGLCNT<4 S PSGLCNT=0 W !
- K DIR S DIR("A")="Press RETURN to continue",DIR("?")="Enter ^ to go to next patient, ^XXX to go to patient XXX, ^^ to go to next ward, ^^^ to go to next team.",DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X" D ^DIR K DIR S OK=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGPLDP0 4467 printed Feb 18, 2025@23:29:11 Page 2
- PSGPLDP0 ;BIR/CML3-ENTER UNITS DISPENSED (PART 2) ;23 OCT 97 / 9:34 AM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- +3 SET PSGPLTND=^PS(53.5,PSGPLG,0)
- SET WSF=$PIECE(PSGPLTND,"^",7)
- +4 IF $PIECE(PSGPLTND,"^",2)
- IF '$PIECE(PSGPLTND,"^",9)
- SET PSGOD=$$ENDTC^PSGMI($PIECE(PSGPLTND,"^",11))
- WRITE $CHAR(7),$CHAR(7),!!?33,"*** WARNING ***",!,"THIS PICK LIST STARTED TO RUN ",PSGOD,", BUT HAS NOT RUN TO COMPLETION."
- +5 ;
- PRN ;
- +1 FOR
- WRITE !!,"Do you want to see PRN meds only"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- DO PRNM^PSGPLDPH
- +2 IF %<0
- SET PRN="^"
- QUIT
- +3 SET PSGLCNT=0
- SET PRN=%-1
- SET (PC,TM)=""
- WRITE @IOF
- +4 ;
- TM ;
- +1 SET OK=""
- FOR
- SET TM=$ORDER(^PS(53.5,"AC",PSGPLG,TM))
- if TM=""
- QUIT
- SET WDN=""
- FOR
- SET WDN=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN))
- if WDN=""
- QUIT
- if PRN&'WSF
- DO W1
- SET RB=""
- FOR
- SET (PR,RB)=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN,RB))
- if RB=""
- QUIT
- SET PN=""
- DO PN
- if OK["^^^"
- GOTO OUT
- if OK["^^"
- GOTO TM
- +2 ;
- OUT ;
- +1 if 'PRN&'PC
- WRITE !!?2,"(No PRN meds founds.)"
- FOR
- WRITE !!,"ARE YOU FINISHED WITH THIS PICK LIST"
- SET %=1
- DO YN^DICN
- if %
- QUIT
- DO FMSG^PSGPLDPH
- +2 if %<0
- QUIT
- if %'=1
- GOTO PRN
- IF $PIECE(PSGPLTND,"^",3)
- DO NOW^%DTC
- IF $PIECE(PSGPLTND,"^",3)>%
- QUIT
- +3 ;
- FILE ;
- +1 FOR
- WRITE !!,"MAY I FILE THE DATA IN THIS PICK LIST AWAY"
- SET %=2
- DO YN^DICN
- if %
- QUIT
- DO FIMSG^PSGPLDPH
- +2 IF %=1
- SET DIE="^PS(53.5,"
- SET DA=PSGPLG
- SET DR=".05////1"
- DO ^DIE
- KILL DIE
- +3 QUIT
- +4 ;
- PN ;
- +1 SET OK=""
- FOR
- Begin DoDot:1
- +2 IF ($EXTRACT(OK,1,1)'="^")&($PIECE(OK,"^",2)'?1.AP)
- SET PN=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN))
- SET OK=""
- QUIT
- +3 SET DIC="^PS(53.5,"_PSGPLG_",1,"
- SET DIC(0)="EQZ"
- SET X=$PIECE(OK,"^",2)
- SET OK=""
- DO ^DIC
- KILL DIC
- IF Y<0
- SET PN=""
- QUIT
- +4 SET Y=$SELECT(WSF:"zns",1:$PIECE(Y(0),"^",3))
- +5 SET RB=$PIECE($GET(^PS(53.5,PSGPLG,1,+Y(0),0)),U,4)
- IF RB]""
- IF $PIECE(^PS(53.5,PSGPLG,0),U,6)
- IF RB'="zz"
- SET RB=$SELECT($PIECE(RB,"-",2)?1N:0,1:"")_$PIECE(RB,"-",2)_"-"_$PIECE(RB,"-")
- +6 SET RB=$SELECT($PIECE(^PS(53.5,PSGPLG,0),"^",8)=1:"zz",RB="":"zz",1:RB)
- +7 IF '$DATA(^PS(53.5,"AC",PSGPLG,$PIECE(Y(0),"^",2),Y,RB,$EXTRACT($PIECE($GET(^DPT(+Y(0),0)),U),1,12)_U_+Y(0)))
- SET PN=""
- KILL Y
- QUIT
- +8 SET PN=$EXTRACT($PIECE($GET(^DPT(+Y(0),0)),U),1,12)_U_+Y(0)
- SET TM=$PIECE(Y(0),"^",2)
- SET WDN=Y
- KILL Y
- End DoDot:1
- if PN=""
- QUIT
- SET PSGP=$PIECE(PN,"^",2)
- SET WF=0
- if WSF&PRN
- DO W1
- if PRN
- DO W2
- DO ST
- if OK["^^"
- QUIT
- if OK="^"
- GOTO PN
- +9 ;
- NP QUIT
- +1 ;
- ST ;
- +1 SET ST="A"
- FOR
- SET ST=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST))
- if "Z"[ST
- QUIT
- DO DRG
- if OK["^"
- QUIT
- +2 QUIT
- +3 ;
- DRG ;
- +1 SET DRG=""
- +2 FOR
- SET DRG=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG))
- if DRG=""
- QUIT
- SET PSGORD=$PIECE(DRG,"^",2)
- SET PSJJORD=+$GET(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,0))
- SET SCH=$PIECE($GET(^PS(55,PSGP,5,PSJJORD,2)),"^")
- IF SCH["PRN"!(ST="P")!PRN
- DO GD
- if OK["^"
- QUIT
- +3 QUIT
- +4 ;
- GD ;
- +1 SET DDRG=""
- FOR
- if OK["^"
- QUIT
- SET DDRG=$ORDER(^PS(53.5,"AC",PSGPLG,TM,WDN,RB,PN,ST,DRG,DDRG))
- if DDRG=""
- QUIT
- SET DN=+$PIECE(DDRG,"^",2)
- SET DN=$GET(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,DN,0))
- SET PDD=$PIECE(DN,"^",3)
- SET PDN=$PIECE(DN,"^",2)
- IF DN'["DI"
- Begin DoDot:1
- +2 IF DN=""
- WRITE !,$$ENPDN^PSGMI(+$GET(^PS(55,PSGP,5,PSJJORD,.2))),?42,"NEEDED: OI",?55,"DISPENSED:"
- DO SCREEN
- QUIT
- +3 SET DR=$PIECE($GET(^PS(55,PSGP,5,PSJJORD,1,+DN,0)),"^")
- SET DR=$$ENDDN^PSGMI(DR)
- +4 SET LMT=PDN*2+1000
- IF 'PRN
- if 'PC
- SET PC=1
- IF 'WF
- SET WF=1
- SET OK="??"
- DO W1
- +5 IF PDN="WS"
- WRITE !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",PDN
- DO SCREEN
- QUIT
- +6 SET PSGLCNT=0
- +7 FOR
- WRITE !,DR,?42,"NEEDED: ",PDN,?55,"DISPENSED: ",$SELECT(PDD="":"",1:PDD_"// ")
- READ OK:DTIME
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST
- SET OK="^^^"
- if $SELECT(OK=+OK
- QUIT
- if OK?1."?"
- DO GDMSG
- IF OK'?1."?"
- WRITE $CHAR(7)," ??"
- +8 if ($EXTRACT(OK,1,1)="^")&($PIECE(OK,"^",2)?1.AP)
- QUIT
- +9 IF OK=""
- SET OK=$SELECT(PDD]"":PDD,PDN="NV":"",1:PDN)
- WRITE " ",OK
- +10 IF OK=+OK
- IF OK'=PDD
- SET $PIECE(^PS(53.5,PSGPLG,1,PSGP,1,PSGORD,1,$PIECE(DDRG,"^",2),0),"^",3)=OK
- End DoDot:1
- +11 QUIT
- +12 ;
- GDMSG ;
- +1 WRITE !!," Enter the number of units actually dispensed for this medication. If the",!,"units dispensed is the same as the units needed (or units dispensed, if shown),",!,"just press the RETURN key."
- +2 WRITE " Enter an '^' to jump ahead to the next patient,",!,"'^^' to jump ahead to the next team, or '^^^' to exit this pick list.",!
- if OK'?2."?"
- QUIT
- +3 ;
- W1 ;
- +1 SET PW=$SELECT('WSF:WDN,1:$PIECE(^PS(53.5,PSGPLG,1,PSGP,0),"^",3))
- SET PSGLCNT=PSGLCNT+.5
- +2 WRITE !!,"TEAM: ",$SELECT(TM'["zz":TM,1:"* N/F *"),?40,"WARD: ",$SELECT(WDN'["zz":PW,1:"* N/F *")
- if OK'?2."?"
- QUIT
- +3 ;
- W2 ;
- +1 SET PSSN=$SELECT($DATA(^DPT(PSGP,0)):$EXTRACT($PIECE(^(0),"^",9),6,9),1:"* N/F *")
- SET PPN=$SELECT('$DATA(^(0)):PN,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:PN)
- SET PR=$PIECE(^PS(53.5,PSGPLG,1,PSGP,0),"^",4)
- +2 WRITE !!,?5,$SELECT($PIECE(PSGPLTND,"^",8):"ROOM-BED: ",$PIECE(PSGPLTND,"^",6):"BED-ROOM: ",1:"ROOM-BED: "),$SELECT(PR'["zz":PR,1:"* N/F *"),?30,PPN," (",PSSN,")",!
- +3 IF '$DATA(^PS(53.5,PSGPLG,1,PSGP,1))
- WRITE !,?20,"(NO ORDERS)",!
- DO SCREEN
- +4 QUIT
- +5 ;
- SCREEN ; display break
- +1 SET PSGLCNT=PSGLCNT+1
- if PSGLCNT<4
- QUIT
- SET PSGLCNT=0
- WRITE !
- +2 KILL DIR
- SET DIR("A")="Press RETURN to continue"
- SET DIR("?")="Enter ^ to go to next patient, ^XXX to go to patient XXX, ^^ to go to next ward, ^^^ to go to next team."
- SET DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X"
- DO ^DIR
- KILL DIR
- SET OK=X
- +3 QUIT
