- PSGAMS ;BIR/CML3-AMIS REPORT ;25 AUG 94 / 12:07 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- ;
- D ENCV^PSGSETU I $D(XQUIT) Q
- S HLP="AMIS" D ENDTS G:'SD!'FD DONE K P S P=0 F Q=0:0 S Q=$O(^PS(53.5,"AB",Q)) Q:'Q S QQ=$O(^(Q,0)) I QQ,QQ'>FD S P=P+1,P(Q)=""
- I P W $C(7),$C(7),!!?32,"*** WARNING ***",!,"PICK LISTS need to be filed away for the following ward group",$E("s",P>1),", or this AMIS"
- I W !,"report will not be accurate for the date range asked for." F Q=0:0 S Q=$O(P(Q)) Q:'Q W !?3,$S($D(^PS(57.5,Q,0)):$P(^(0),"^"),1:Q)
- ;
- GO ;
- S RTN="AMS" D EN3^PSGTI I 'POP,'$D(IO("Q")) D ENQ D:IO'=IO(0)!($E(IOST)'="C") ^%ZISC
- ;
- DONE ;
- D ENKV^PSGSETU K ^UTILITY("PSG",$J),DRG,FD,HLP,ND,NU,P,PR,RTN,SD,ST,STOP,STRT,W,WN,ZTOUT Q
- ;
- ENQ ;
- K ^UTILITY("PSG",$J) F ST=SD:0 S ST=$O(^PS(57.6,ST)) Q:'ST!(ST>FD) S W=0 F S W=$O(^PS(57.6,ST,1,W)) Q:'W S WN=$S(W'=+W:"UNKNOWN",'$D(^DIC(42,W,0)):W,$P(^(0),"^")]"":$P(^(0),"^"),1:W) D GPR
- D ^PSGAMS0 Q
- ;
- GPR ;
- S PR=0 F S PR=$O(^PS(57.6,ST,1,W,1,PR)) Q:'PR S DRG=0 F S DRG=$O(^PS(57.6,ST,1,W,1,PR,1,DRG)) Q:'DRG I $D(^(DRG,0)) S ND=^(0) D ADD
- Q
- ;
- ADD ;
- S NU=$G(^UTILITY("PSG",$J,WN)),$P(NU,"^")=+NU+$P(ND,"^",2)-$P(ND,"^",4),$P(NU,"^",2)=$P(NU,"^",2)+$P(ND,"^",3)-$P(ND,"^",5),^(WN)=NU Q
- ;
- ;
- ENDTS ;
- S (SD,FD)=0,PSGID=$S(HLP'="COST AT DISCHARGE":$O(^PS(57.6,0)),1:$O(^PS(55,"AUDDD",0))) I 'PSGID W $C(7),!!?10,"*** THERE IS NO DATA FOR THIS REPORT, YET. ***" Q
- K %DT S FIRST=$E($$ENDTC^PSGMI(PSGID),1,8),%DT="EXP",D="START" D DT I Y>0 S (STRT,%DT(0))=+Y,D="STOP" D DT I Y>0 S (STOP,FD)=+Y,X1=STRT,X2=-1 D C^%DTC S SD=X F X="STRT","STOP" S @X=$P($$ENDTC^PSGMI(@X)," ")
- K %DT,FIRST Q
- ;
- DT ;
- S Y=-1 F W !!,"Enter ",D," DATE: " R X:DTIME W:'$T $C(7) S:'$T X="^" D DTM:X?1."?",^%DT:"^"'[X I Y>0!("^"[X) W:Y'>0 $C(7),!?3,"No ",D," date chosen, or ",HLP," report run." Q
- Q
- ;
- DTM ;
- S X1=HLP="COST AT DISCHARGE",X2=$S(D="START"&X1:" ",1:"")
- W !!?2,"Enter the ",D," date of the range of dates for this ",HLP," report "_X2_"to run." W:X1 " " W:'X1 ! W "The start and stop dates may be the same, in effect, a one day report."
- W:D="STOP" " "_$S(X1:" ",1:"")_"The stop"_$S(X1:" ",1:"")_"date may not come before the start date." W !?2,"Dates are inclusive. (The first date found is "_FIRST_".)" Q
- ;
- ENDC ;
- S PSGID=$O(^PS(57.6,0)) I 'PSGID W $C(7),!!?10,"** There is no data for this report, yet. **" Q
- S FIRST=$$ENDTC^PSGMI(PSGID) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGAMS 2435 printed Feb 18, 2025@23:27:07 Page 2
- PSGAMS ;BIR/CML3-AMIS REPORT ;25 AUG 94 / 12:07 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- +2 ;
- +3 DO ENCV^PSGSETU
- IF $DATA(XQUIT)
- QUIT
- +4 SET HLP="AMIS"
- DO ENDTS
- if 'SD!'FD
- GOTO DONE
- KILL P
- SET P=0
- FOR Q=0:0
- SET Q=$ORDER(^PS(53.5,"AB",Q))
- if 'Q
- QUIT
- SET QQ=$ORDER(^(Q,0))
- IF QQ
- IF QQ'>FD
- SET P=P+1
- SET P(Q)=""
- +5 IF P
- WRITE $CHAR(7),$CHAR(7),!!?32,"*** WARNING ***",!,"PICK LISTS need to be filed away for the following ward group",$EXTRACT("s",P>1),", or this AMIS"
- +6 IF $TEST
- WRITE !,"report will not be accurate for the date range asked for."
- FOR Q=0:0
- SET Q=$ORDER(P(Q))
- if 'Q
- QUIT
- WRITE !?3,$SELECT($DATA(^PS(57.5,Q,0)):$PIECE(^(0),"^"),1:Q)
- +7 ;
- GO ;
- +1 SET RTN="AMS"
- DO EN3^PSGTI
- IF 'POP
- IF '$DATA(IO("Q"))
- DO ENQ
- if IO'=IO(0)!($EXTRACT(IOST)'="C")
- DO ^%ZISC
- +2 ;
- DONE ;
- +1 DO ENKV^PSGSETU
- KILL ^UTILITY("PSG",$JOB),DRG,FD,HLP,ND,NU,P,PR,RTN,SD,ST,STOP,STRT,W,WN,ZTOUT
- QUIT
- +2 ;
- ENQ ;
- +1 KILL ^UTILITY("PSG",$JOB)
- FOR ST=SD:0
- SET ST=$ORDER(^PS(57.6,ST))
- if 'ST!(ST>FD)
- QUIT
- SET W=0
- FOR
- SET W=$ORDER(^PS(57.6,ST,1,W))
- if 'W
- QUIT
- SET WN=$SELECT(W'=+W:"UNKNOWN",'$DATA(^DIC(42,W,0)):W,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:W)
- DO GPR
- +2 DO ^PSGAMS0
- QUIT
- +3 ;
- GPR ;
- +1 SET PR=0
- FOR
- SET PR=$ORDER(^PS(57.6,ST,1,W,1,PR))
- if 'PR
- QUIT
- SET DRG=0
- FOR
- SET DRG=$ORDER(^PS(57.6,ST,1,W,1,PR,1,DRG))
- if 'DRG
- QUIT
- IF $DATA(^(DRG,0))
- SET ND=^(0)
- DO ADD
- +2 QUIT
- +3 ;
- ADD ;
- +1 SET NU=$GET(^UTILITY("PSG",$JOB,WN))
- SET $PIECE(NU,"^")=+NU+$PIECE(ND,"^",2)-$PIECE(ND,"^",4)
- SET $PIECE(NU,"^",2)=$PIECE(NU,"^",2)+$PIECE(ND,"^",3)-$PIECE(ND,"^",5)
- SET ^(WN)=NU
- QUIT
- +2 ;
- +3 ;
- ENDTS ;
- +1 SET (SD,FD)=0
- SET PSGID=$SELECT(HLP'="COST AT DISCHARGE":$ORDER(^PS(57.6,0)),1:$ORDER(^PS(55,"AUDDD",0)))
- IF 'PSGID
- WRITE $CHAR(7),!!?10,"*** THERE IS NO DATA FOR THIS REPORT, YET. ***"
- QUIT
- +2 KILL %DT
- SET FIRST=$EXTRACT($$ENDTC^PSGMI(PSGID),1,8)
- SET %DT="EXP"
- SET D="START"
- DO DT
- IF Y>0
- SET (STRT,%DT(0))=+Y
- SET D="STOP"
- DO DT
- IF Y>0
- SET (STOP,FD)=+Y
- SET X1=STRT
- SET X2=-1
- DO C^%DTC
- SET SD=X
- FOR X="STRT","STOP"
- SET @X=$PIECE($$ENDTC^PSGMI(@X)," ")
- +3 KILL %DT,FIRST
- QUIT
- +4 ;
- DT ;
- +1 SET Y=-1
- FOR
- WRITE !!,"Enter ",D," DATE: "
- READ X:DTIME
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST
- SET X="^"
- if X?1."?"
- DO DTM
- if "^"'[X
- DO ^%DT
- IF Y>0!("^"[X)
- if Y'>0
- WRITE $CHAR(7),!?3,"No ",D," date chosen, or ",HLP," report run."
- QUIT
- +2 QUIT
- +3 ;
- DTM ;
- +1 SET X1=HLP="COST AT DISCHARGE"
- SET X2=$SELECT(D="START"&X1:" ",1:"")
- +2 WRITE !!?2,"Enter the ",D," date of the range of dates for this ",HLP," report "_X2_"to run."
- if X1
- WRITE " "
- if 'X1
- WRITE !
- WRITE "The start and stop dates may be the same, in effect, a one day report."
- +3 if D="STOP"
- WRITE " "_$SELECT(X1:" ",1:"")_"The stop"_$SELECT(X1:" ",1:"")_"date may not come before the start date."
- WRITE !?2,"Dates are inclusive. (The first date found is "_FIRST_".)"
- QUIT
- +4 ;
- ENDC ;
- +1 SET PSGID=$ORDER(^PS(57.6,0))
- IF 'PSGID
- WRITE $CHAR(7),!!?10,"** There is no data for this report, yet. **"
- QUIT
- +2 SET FIRST=$$ENDTC^PSGMI(PSGID)
- QUIT