PSJPR0.m

PSJPR0 ;BIR/CML3,PR-INPATIENT MEDS PROFILE - GATHER ORDERS ;2/3/92  15:43 [ 12/16/97  2:07 PM ]

 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 ;

 D NOW^%DTC S PSGDT=%,(X1,DT)=$P(%,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1),PSGID=PSGDT,HDT=$$ENDTC^PSGMI(PSGDT) K ^UTILITY("PSG",$J)

 W !!,"...a few moments, please..." D ENUNM^PSGOU

 S C="A",ST="O" F SD=PSGPAD:0 S SD=$O(^PS(55,PSGP,5,"AU","O",SD)) Q:'SD  F O=0:0 S O=$O(^PS(55,PSGP,5,"AU","O",SD,O)) Q:'O  D OCHK

 F ST="C","OC","P","R" F SD=PSGPAD:0 S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD  F O=0:0 S O=$O(^PS(55,PSGP,5,"AU",ST,SD,O)) Q:'O  D ECHK

 F ON=0:0 S ON=$O(^PS(55,DFN,"IV",ON)) Q:'ON  I $D(^(ON,0)) D CHK^PSIVACT K PS S ST=$P(^PS(55,DFN,"IV",ON,0),"^",17) S IV=$S(ST="D":1,1:$P(^(0),"^",3)'>PSGDT),C=$E("O",IV)_"IV" D:'IV!(PSGOL="L"&IV) IV

 F SD="I","N" F O=0:0 S O=$O(^PS(53.1,"AS",SD,PSGP,O)) Q:'O  S ST=$S('$D(^PS(53.1,O,0)):"z",$P(^(0),"^",7)]"":$P(^(0),"^",7),1:"z"),DRG=$S($D(^(1,1,0)):+^(0),1:""),C="N"_$S(SD="N":"X",1:"Y") D SET

 Q

 ;

OCHK ;

 S C="A" G:SD>PSGDT!$S('PSJSYSU:0,'$D(^PS(55,PSGP,5,O,0)):0,"D"[$E($P(^(0),"^",9)):0,'$D(^(4)):1,'$P(^(4),"^",+PSJSYSU):1,SD<PSGODT:0,1:$P(^(4),"^",16)) DS Q:PSGOL["S"  S C="O" G DS

 ;

ECHK ;

 S C="A" G:SD>PSGDT!$S(SD<PSGODT:0,'$D(^PS(55,PSGP,5,O,0)):0,$P(^(0),"^",9)'="E":0,'$D(^(4)):0,1:$P(^(4),"^",16)) DS Q:PSGOL="S"  S C="O" G DS

 ;

IV ;

 S ^UTILITY("PSG",$J,C,ST,$S('$D(^PS(52.6,+$O(^PS(DFN,"IV",ON,"AD",0)),0)):"z",$P(^(0),"^")]"":$P(^(0),"^"),1:"z"),ON)="" Q

 ;

DS S DRG=$S($D(^PS(55,PSGP,5,O,1,1,0)):+^(0),1:0)

SET S ^UTILITY("PSG",$J,C,ST,$S('$D(^PSDRUG(DRG,0)):"z",$P(^(0),"^")]"":$P(^(0),"^"),1:"z"),O)="" Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSJPR0   1649     printed  Apr 09, 2024@21:05:08                                                                                                                                                                                                      Page 2

PSJPR0    ;BIR/CML3,PR-INPATIENT MEDS PROFILE - GATHER ORDERS ;2/3/92  15:43 [ 12/16/97  2:07 PM ]

 +1       ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97

 +2       ;

 +3        DO NOW^%DTC

           SET PSGDT=%

           SET (X1,DT)=$PIECE(%,".")

           SET X2=-2

           DO C^%DTC

           SET PSGODT=X_(PSGDT#1)

           SET PSGID=PSGDT

           SET HDT=$$ENDTC^PSGMI(PSGDT)

           KILL ^UTILITY("PSG",$JOB)

 +4        WRITE !!,"...a few moments, please..."

           DO ENUNM^PSGOU

 +5        SET C="A"

           SET ST="O"

           FOR SD=PSGPAD:0

               SET SD=$ORDER(^PS(55,PSGP,5,"AU","O",SD))

               if 'SD

                   QUIT 

               FOR O=0:0

                   SET O=$ORDER(^PS(55,PSGP,5,"AU","O",SD,O))

                   if 'O

                       QUIT 

                   DO OCHK

 +6        FOR ST="C","OC","P","R"

               FOR SD=PSGPAD:0

                   SET SD=$ORDER(^PS(55,PSGP,5,"AU",ST,SD))

                   if 'SD

                       QUIT 

                   FOR O=0:0

                       SET O=$ORDER(^PS(55,PSGP,5,"AU",ST,SD,O))

                       if 'O

                           QUIT 

                       DO ECHK

 +7        FOR ON=0:0

               SET ON=$ORDER(^PS(55,DFN,"IV",ON))

               if 'ON

                   QUIT 

               IF $DATA(^(ON,0))

                   DO CHK^PSIVACT

                   KILL PS

                   SET ST=$PIECE(^PS(55,DFN,"IV",ON,0),"^",17)

                   SET IV=$SELECT(ST="D":1,1:$PIECE(^(0),"^",3)'>PSGDT)

                   SET C=$EXTRACT("O",IV)_"IV"

                   if 'IV!(PSGOL="L"&IV)

                       DO IV

 +8        FOR SD="I","N"

               FOR O=0:0

                   SET O=$ORDER(^PS(53.1,"AS",SD,PSGP,O))

                   if 'O

                       QUIT 

                   SET ST=$SELECT('$DATA(^PS(53.1,O,0)):"z",$PIECE(^(0),"^",7)]"":$PIECE(^(0),"^",7),1:"z")

                   SET DRG=$SELECT($DATA(^(1,1,0)):+^(0),1:"")

                   SET C="N"_$SELECT(SD="N":"X",1:"Y")

                   DO SET

 +9        QUIT 

 +10      ;

OCHK      ;

 +1        SET C="A"

           if SD>PSGDT!$SELECT('PSJSYSU

               GOTO DS

           if PSGOL["S"

               QUIT 

           SET C="O"

           GOTO DS

 +2       ;

ECHK      ;

 +1        SET C="A"

           if SD>PSGDT!$SELECT(SD<PSGODT

               GOTO DS

           if PSGOL="S"

               QUIT 

           SET C="O"

           GOTO DS

 +2       ;

IV        ;

 +1        SET ^UTILITY("PSG",$JOB,C,ST,$SELECT('$DATA(^PS(52.6,+$ORDER(^PS(DFN,"IV",ON,"AD",0)),0)):"z",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"z"),ON)=""

           QUIT 

 +2       ;

DS         SET DRG=$SELECT($DATA(^PS(55,PSGP,5,O,1,1,0)):+^(0),1:0)

SET        SET ^UTILITY("PSG",$JOB,C,ST,$SELECT('$DATA(^PSDRUG(DRG,0)):"z",$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:"z"),O)=""

           QUIT 

 +1       ;