PSSGIU.m

PSSGIU ;BIR/CML3-GENERIC "APPLICATION PACKAGES' USE" SET ; 09/09/97 9:31

 ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97

 ;

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)=""

 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)

 G DONE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSSGIU   2170     printed  Apr 09, 2024@21:33:26                                                                                                                                                                                                      Page 2

PSSGIU    ;BIR/CML3-GENERIC "APPLICATION PACKAGES' USE" SET ; 09/09/97 9:31

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97

 +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        GOTO DONE

 +5       ;

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        GOTO DONE