- PSSGIU ;BIR/CML-GENERIC "APPLICATION PACKAGES' USE" SET; Jun 04, 2024@14:00
- ;;1.0;PHARMACY DATA MANAGEMENT;**266**;9/30/97;Build 3
- ;
- EN ;
- Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,PSIUX'?1E1"^"1.E:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIUO=$P($G(^(2)),"^",3) S PSIUT=$P(PSIUX,"^",2),PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT,(%,PSIUQ)=PSIUO'[$E(PSIUX)+1
- F W !!,"A",PSIUT," ITEM" D YN^DICN Q:% D MQ S %=PSIUQ
- I %<0 S PSIUA="^" G DONE
- S PSIUA=$E("YN",%) G:%=PSIUQ DONE I %=1 S PSIUY=PSIUO_$P(PSIUX,"^"),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY I $P(^(0),"^")]"" S ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)=""
- I %=2 D CMOP S PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY I $P(^(0),"^")]"" K ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)
- K:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA) S:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)=""
- ;
- DONE ;
- K PSIU,PSIUO,PSIUQ,PSIUT,PSIUY Q
- ;
- MQ ;
- S X="Enter 'YES' (or 'Y') to mark this drug as a"_$S($E(PSIUT,1,2)="N ":"n"_$E(PSIUT,2,99),1:PSIUT)_" item. Enter 'NO' (or 'N') to not mark (or unmark) this drug."
- W !!?2 F PSIU=1:1:$L(X," ") S Y=$P(X," ",PSIU) W:$X+$L(Y)>79 ! W Y," "
- Q
- CMOP I PSIUX="O^Outpatient Pharmacy",$P($G(^PSDRUG(PSIUDA,3)),"^",1)=1 W !,"This item has just been UNMARKED for CMOP transmission.",! S $P(^PSDRUG(PSIUDA,3),"^")=0 K ^PSDRUG("AQ",PSIUDA) S DA=PSIUDA N % D ^PSSREF
- Q
- ;
- ENS ;
- Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,'PSIUDA:1,$L($P(PSIUX,"^"))'=1:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIU=$P(^(0),"^"),(PSIUO,PSIUY)=$P($G(^(2)),"^",3),PSIUT=$P(PSIUX,"^")
- I PSIUY'[PSIUT S PSIUY=PSIUY_PSIUT,$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY K:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA)
- S ^PSDRUG("IU",PSIUY,PSIUDA)="" I PSIU]"" S ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)=""
- ;PSS*1.0*266: Update CPRS orderable item list
- N PSGOI
- S PSGOI=$$GET1^DIQ(50,PSIUDA,2.1,"I")
- Q:'PSGOI
- D EN2^PSSHL1(PSGOI,"MUP")
- G DONE
- ;
- END ;
- Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,'PSIUDA:1,$L($P(PSIUX,"^"))'=1:1,1:'$D(^PSDRUG(PSIUDA,0))) S PSIU=$P(^(0),"^"),(PSIUO,PSIUY)=$P($G(^(2)),"^",3),PSIUT=$P(PSIUX,"^")
- I PSIUY[PSIUT S PSIUY=$P(PSIUY,PSIUT)_$P(PSIUY,PSIUT,2),$P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY K ^PSDRUG("IU",PSIUO,PSIUDA)
- S:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)="" I PSIU]"" K ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)
- ;PSS*1.0*266: Update CPRS orderable item list
- N PSGOI
- S PSGOI=$$GET1^DIQ(50,PSIUDA,2.1,"I")
- Q:'PSGOI
- D EN2^PSSHL1(PSGOI,"MUP")
- G DONE
- ;
- ;PSS*1.0*266 begin - copied from PSGFILD3
- ENIU ; mark/unmark drugs for Unit Dose use
- N DIR,DTOUT,DUOUT,DIROUT,DIRUT,DIC,X,Y,PSIUDA,PSIUX,PSGS,PSGY
- S DIR(0)="SAO^M:MARK FOR UNIT DOSE;U:UNMARK FOR UNIT DOSE"
- S DIR("A")="Do you want to (M)ARK or (U)NMARK items for Unit Dose? "
- S DIR("B")="UNMARK",DIR("?")="^D ENIUH^PSSGIU"
- W ! D ^DIR
- I Y'="U",Y'="M" Q
- S PSGY=Y,PSGS="I $P($G(^(2)),""^"",3)"_$E("'",PSGY="M")_"[""U""",PSIUX="U"
- S DIC="^PSDRUG(",DIC(0)="QEAM",DIC("A")="Select DRUG: ",DIC("S")=PSGS
- F W ! D ^DIC Q:Y'>0 D
- . S PSIUDA=+Y
- . D:PSGY="U" END
- . D:PSGY="M" ENS
- . W "..."
- . W:PSGY="U" "UN" W "MARKED..."
- Q
- ;
- ENIUH ;
- W !!?2,"Enter 'M' to mark items for use by the Unit Dose Medications package."
- W " (You",!,"will only be shown items that have not been marked for Unit Dose.)"
- W !?2,"Enter 'U' to unmark items that have previously been marked for use with Unit"
- W !,"Dose. (You will be shown only items that have already been marked for Unit",!,"Dose.)"
- W !!,"Choose from:",!?3,"M MARK ITEMS FOR UNIT DOSE",!?3,"U UNMARK ITEMS FOR UNIT DOSE"
- ;PSS*1.0*266 end
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSGIU 3590 printed Jan 18, 2025@03:32:19 Page 2
- PSSGIU ;BIR/CML-GENERIC "APPLICATION PACKAGES' USE" SET; Jun 04, 2024@14:00
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**266**;9/30/97;Build 3
- +2 ;
- EN ;
- +1 if $SELECT('$DATA(PSIUDA)
- QUIT
- SET PSIUO=$PIECE($GET(^(2)),"^",3)
- SET PSIUT=$PIECE(PSIUX,"^",2)
- SET PSIUT=$SELECT($EXTRACT(PSIUT,1,4)="UNIT":"",1:$EXTRACT("N","AEIOU"[$EXTRACT(PSIUT)))_" "_PSIUT
- SET (%,PSIUQ)=PSIUO'[$EXTRACT(PSIUX)+1
- +2 FOR
- WRITE !!,"A",PSIUT," ITEM"
- DO YN^DICN
- if %
- QUIT
- DO MQ
- SET %=PSIUQ
- +3 IF %<0
- SET PSIUA="^"
- GOTO DONE
- +4 SET PSIUA=$EXTRACT("YN",%)
- if %=PSIUQ
- GOTO DONE
- IF %=1
- SET PSIUY=PSIUO_$PIECE(PSIUX,"^")
- SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
- IF $PIECE(^(0),"^")]""
- SET ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),PSIUDA)=""
- +5 IF %=2
- DO CMOP
- SET PSIUY=$PIECE(PSIUO,$PIECE(PSIUX,"^"))_$PIECE(PSIUO,$PIECE(PSIUX,"^"),2)
- SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
- IF $PIECE(^(0),"^")]""
- KILL ^PSDRUG("AIU"_$PIECE(PSIUX,"^"),$PIECE(^(0),"^"),PSIUDA)
- +6 if PSIUO]""
- KILL ^PSDRUG("IU",PSIUO,PSIUDA)
- if PSIUY]""
- SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
- +7 ;
- DONE ;
- +1 KILL PSIU,PSIUO,PSIUQ,PSIUT,PSIUY
- QUIT
- +2 ;
- MQ ;
- +1 SET X="Enter 'YES' (or 'Y') to mark this drug as a"_$SELECT($EXTRACT(PSIUT,1,2)="N ":"n"_$EXTRACT(PSIUT,2,99),1:PSIUT)_" item. Enter 'NO' (or 'N') to not mark (or unmark) this drug."
- +2 WRITE !!?2
- FOR PSIU=1:1:$LENGTH(X," ")
- SET Y=$PIECE(X," ",PSIU)
- if $X+$LENGTH(Y)>79
- WRITE !
- WRITE Y," "
- +3 QUIT
- CMOP IF PSIUX="O^Outpatient Pharmacy"
- IF $PIECE($GET(^PSDRUG(PSIUDA,3)),"^",1)=1
- WRITE !,"This item has just been UNMARKED for CMOP transmission.",!
- SET $PIECE(^PSDRUG(PSIUDA,3),"^")=0
- KILL ^PSDRUG("AQ",PSIUDA)
- SET DA=PSIUDA
- NEW %
- DO ^PSSREF
- +1 QUIT
- +2 ;
- ENS ;
- +1 if $SELECT('$DATA(PSIUDA)
- QUIT
- SET PSIU=$PIECE(^(0),"^")
- SET (PSIUO,PSIUY)=$PIECE($GET(^(2)),"^",3)
- SET PSIUT=$PIECE(PSIUX,"^")
- +2 IF PSIUY'[PSIUT
- SET PSIUY=PSIUY_PSIUT
- SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
- if PSIUO]""
- KILL ^PSDRUG("IU",PSIUO,PSIUDA)
- +3 SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
- IF PSIU]""
- SET ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)=""
- +4 ;PSS*1.0*266: Update CPRS orderable item list
- +5 NEW PSGOI
- +6 SET PSGOI=$$GET1^DIQ(50,PSIUDA,2.1,"I")
- +7 if 'PSGOI
- QUIT
- +8 DO EN2^PSSHL1(PSGOI,"MUP")
- +9 GOTO DONE
- +10 ;
- END ;
- +1 if $SELECT('$DATA(PSIUDA)
- QUIT
- SET PSIU=$PIECE(^(0),"^")
- SET (PSIUO,PSIUY)=$PIECE($GET(^(2)),"^",3)
- SET PSIUT=$PIECE(PSIUX,"^")
- +2 IF PSIUY[PSIUT
- SET PSIUY=$PIECE(PSIUY,PSIUT)_$PIECE(PSIUY,PSIUT,2)
- SET $PIECE(^PSDRUG(PSIUDA,2),"^",3)=PSIUY
- KILL ^PSDRUG("IU",PSIUO,PSIUDA)
- +3 if PSIUY]""
- SET ^PSDRUG("IU",PSIUY,PSIUDA)=""
- IF PSIU]""
- KILL ^PSDRUG("AIU"_PSIUT,PSIU,PSIUDA)
- +4 ;PSS*1.0*266: Update CPRS orderable item list
- +5 NEW PSGOI
- +6 SET PSGOI=$$GET1^DIQ(50,PSIUDA,2.1,"I")
- +7 if 'PSGOI
- QUIT
- +8 DO EN2^PSSHL1(PSGOI,"MUP")
- +9 GOTO DONE
- +10 ;
- +11 ;PSS*1.0*266 begin - copied from PSGFILD3
- ENIU ; mark/unmark drugs for Unit Dose use
- +1 NEW DIR,DTOUT,DUOUT,DIROUT,DIRUT,DIC,X,Y,PSIUDA,PSIUX,PSGS,PSGY
- +2 SET DIR(0)="SAO^M:MARK FOR UNIT DOSE;U:UNMARK FOR UNIT DOSE"
- +3 SET DIR("A")="Do you want to (M)ARK or (U)NMARK items for Unit Dose? "
- +4 SET DIR("B")="UNMARK"
- SET DIR("?")="^D ENIUH^PSSGIU"
- +5 WRITE !
- DO ^DIR
- +6 IF Y'="U"
- IF Y'="M"
- QUIT
- +7 SET PSGY=Y
- SET PSGS="I $P($G(^(2)),""^"",3)"_$EXTRACT("'",PSGY="M")_"[""U"""
- SET PSIUX="U"
- +8 SET DIC="^PSDRUG("
- SET DIC(0)="QEAM"
- SET DIC("A")="Select DRUG: "
- SET DIC("S")=PSGS
- +9 FOR
- WRITE !
- DO ^DIC
- if Y'>0
- QUIT
- Begin DoDot:1
- +10 SET PSIUDA=+Y
- +11 if PSGY="U"
- DO END
- +12 if PSGY="M"
- DO ENS
- +13 WRITE "..."
- +14 if PSGY="U"
- WRITE "UN"
- WRITE "MARKED..."
- End DoDot:1
- +15 QUIT
- +16 ;
- ENIUH ;
- +1 WRITE !!?2,"Enter 'M' to mark items for use by the Unit Dose Medications package."
- +2 WRITE " (You",!,"will only be shown items that have not been marked for Unit Dose.)"
- +3 WRITE !?2,"Enter 'U' to unmark items that have previously been marked for use with Unit"
- +4 WRITE !,"Dose. (You will be shown only items that have already been marked for Unit",!,"Dose.)"
- +5 WRITE !!,"Choose from:",!?3,"M MARK ITEMS FOR UNIT DOSE",!?3,"U UNMARK ITEMS FOR UNIT DOSE"
- +6 ;PSS*1.0*266 end
- +7 QUIT
- +8 ;