PSGDCT1 ;BIR/DAV,MLM-DRUG COST TOTALS SORTING ;21 MAY 96 / 7:49 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
;
K ^TMP($J) S PSGP2=$S(PSGDCT=1:0,1:$D(PSGDISP)),ST=SD F S ST=$O(^PS(57.6,ST)) Q:'ST!(ST>FD) D
.S W=0 F S W=$O(^PS(57.6,ST,1,W)) Q:W="" D
..S WD=+$G(^PS(57.6,ST,1,W,0)) Q:$S('$D(PSGDCLW):0,PSGDCLW="ALL":0,1:'$D(PSGDCLW(WD))) S S3=$S($D(PSGDCLW):WD,1:"ZZ") S:S3 S3=$P($G(^DIC(42,WD,0)),U)_U_WD
..S PR=0 F S PR=$O(^PS(57.6,ST,1,W,1,PR)) Q:PR="" D
...S DRG=0 F S DRG=$O(^PS(57.6,ST,1,W,1,PR,1,DRG)) Q:'DRG D SET
Q
SET ; Set subscripts.
S ND=^PS(57.6,ST,1,W,1,PR,1,DRG,0),ND50=$G(^PSDRUG(+DRG,0)),S2=$$SETDRG("DISPENSE DRUG",$P(ND50,U),+DRG)
I PSGDCT=1 D:'$$EXCLUDE(DRG) SETTMP(S2,S2,S3,ND) Q
I PSGDCT=2 S OI=+$P($G(^PSDRUG(+DRG,2)),U) Q:$$EXCLUDE(OI) S S1=$$OIDF(OI) D SETTMP(S1,S2,S3,ND) Q
S S1=$$SETDRG("VA CLASS",$P($G(^PSDRUG(DRG,0)),U,2),"") D:'$$EXCLUDE(S1) SETTMP(S1,S2,S3,ND) Q
Q
;
EXCLUDE(X) ; Check if item is to be included in report.
S X=$P(X,U)
Q $S($G(PSGDCTD)="ALL":0,X="":1,1:'$D(PSGDCTD(X)))
;
SETDRG(TYP,X,IEN) ;TYP=TYPE OF DATA, X=DATA NAME, IEN=IEN OF DATA.
Q $S(X]"":X_U_IEN,1:"Unknown "_TYP_" ("_IEN_")")
;
OIDF(OIND) ; Return Orderable Item name and Dosage form.
;; +OIND = orderable item IEN
NEW X,NAME
S X=$G(^PS(50.7,+OIND,0))
S:$P(X,U)]"" NAME=$P(X,U)_" "_$P($G(^PS(50.606,+$P(X,U,2),0)),U)_U_OIND
Q $S($G(NAME)]"":NAME,1:"Unknown ORDERABLE ITEM "_"("_OIND_")")
;
SETTMP(S1,S2,S3,ND) ; Set TMP by select type, dispense drug, and maybe ward.
S ^TMP($J,"S1",S1,0)=$$INC($G(^TMP($J,"S1",S1,0)),ND) S:PSGDCT=1 $P(^(0),U,3)=$P(ND50,U,9)
I S2]"",$D(PSGDISP) S ^TMP($J,"S1",S1,S2,0)=$$INC($G(^TMP($J,"S1",S1,S2,0)),ND),$P(^(0),U,3)=$P(ND50,U,9)
I S3'="ZZ" S X="^TMP($J,""S1"",S1,"_$S('PSGP2:"S3",1:"S2,S3")_",0)",@X=$$INC($G(@X),ND)
Q
;
INC(X,ND) ;Increment amount and cost.
Q +X+$P(ND,U,2)-$P(ND,U,4)_U_($P(X,U,2)+$P(ND,U,3)-$P(ND,U,5))
;
CLM ;
W !!?2,"Enter a number (dollar amount) to be the lower limit for this report. This number may be zero (0) to include all drugs with a positive cost. A NULL",!,"response will include all drugs. Enter an '^' to terminate this report." Q
;
ALM ;
W !!?2,"Enter a number to be the lower dispensing limit (inclusive) for this report.",!,"This number may be zero (0) to include all drugs with a positive dispensing",!,"amount. A NULL response will include all drugs. Enter an '^' to "
W !,"terminate this report."
Q
;
SDH ;
W !!?2,"Select a DRUG for which you wish to have cost data print."
Q
;
SBCHK ;
W !!,"Enter '",$E(PSGDCT(1),1),"' to have this report print the drugs in order of ",PSGDCT(2),".",!,"Enter 'C' to have this report print the drugs in descending order of TOTAL COST."
W !,"Enter 'A' to have this report print the drugs in descending order of the",!,"AMOUNT DISPENSED (in UNITS)." S PSGDCTS=""
Q
;
ENQH ;
W !!,"Enter the category that the drugs on the report will be selected by...",!,"Enter 'D' for Dispensed Drug",!,"Enter 'O' for Orderable Item",!,"Enter 'V' for VA Class...."
Q
WDHLP ;
W !!,"Enter ""YES"" to include dispensing amounts and cost by ward.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGDCT1 3177 printed Sep 23, 2025@19:37:09 Page 2
PSGDCT1 ;BIR/DAV,MLM-DRUG COST TOTALS SORTING ;21 MAY 96 / 7:49 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
+3 KILL ^TMP($JOB)
SET PSGP2=$SELECT(PSGDCT=1:0,1:$DATA(PSGDISP))
SET ST=SD
FOR
SET ST=$ORDER(^PS(57.6,ST))
if 'ST!(ST>FD)
QUIT
Begin DoDot:1
+4 SET W=0
FOR
SET W=$ORDER(^PS(57.6,ST,1,W))
if W=""
QUIT
Begin DoDot:2
+5 SET WD=+$GET(^PS(57.6,ST,1,W,0))
if $SELECT('$DATA(PSGDCLW)
QUIT
SET S3=$SELECT($DATA(PSGDCLW):WD,1:"ZZ")
if S3
SET S3=$PIECE($GET(^DIC(42,WD,0)),U)_U_WD
+6 SET PR=0
FOR
SET PR=$ORDER(^PS(57.6,ST,1,W,1,PR))
if PR=""
QUIT
Begin DoDot:3
+7 SET DRG=0
FOR
SET DRG=$ORDER(^PS(57.6,ST,1,W,1,PR,1,DRG))
if 'DRG
QUIT
DO SET
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
SET ; Set subscripts.
+1 SET ND=^PS(57.6,ST,1,W,1,PR,1,DRG,0)
SET ND50=$GET(^PSDRUG(+DRG,0))
SET S2=$$SETDRG("DISPENSE DRUG",$PIECE(ND50,U),+DRG)
+2 IF PSGDCT=1
if '$$EXCLUDE(DRG)
DO SETTMP(S2,S2,S3,ND)
QUIT
+3 IF PSGDCT=2
SET OI=+$PIECE($GET(^PSDRUG(+DRG,2)),U)
if $$EXCLUDE(OI)
QUIT
SET S1=$$OIDF(OI)
DO SETTMP(S1,S2,S3,ND)
QUIT
+4 SET S1=$$SETDRG("VA CLASS",$PIECE($GET(^PSDRUG(DRG,0)),U,2),"")
if '$$EXCLUDE(S1)
DO SETTMP(S1,S2,S3,ND)
QUIT
+5 QUIT
+6 ;
EXCLUDE(X) ; Check if item is to be included in report.
+1 SET X=$PIECE(X,U)
+2 QUIT $SELECT($GET(PSGDCTD)="ALL":0,X="":1,1:'$DATA(PSGDCTD(X)))
+3 ;
SETDRG(TYP,X,IEN) ;TYP=TYPE OF DATA, X=DATA NAME, IEN=IEN OF DATA.
+1 QUIT $SELECT(X]"":X_U_IEN,1:"Unknown "_TYP_" ("_IEN_")")
+2 ;
OIDF(OIND) ; Return Orderable Item name and Dosage form.
+1 ;; +OIND = orderable item IEN
+2 NEW X,NAME
+3 SET X=$GET(^PS(50.7,+OIND,0))
+4 if $PIECE(X,U)]""
SET NAME=$PIECE(X,U)_" "_$PIECE($GET(^PS(50.606,+$PIECE(X,U,2),0)),U)_U_OIND
+5 QUIT $SELECT($GET(NAME)]"":NAME,1:"Unknown ORDERABLE ITEM "_"("_OIND_")")
+6 ;
SETTMP(S1,S2,S3,ND) ; Set TMP by select type, dispense drug, and maybe ward.
+1 SET ^TMP($JOB,"S1",S1,0)=$$INC($GET(^TMP($JOB,"S1",S1,0)),ND)
if PSGDCT=1
SET $PIECE(^(0),U,3)=$PIECE(ND50,U,9)
+2 IF S2]""
IF $DATA(PSGDISP)
SET ^TMP($JOB,"S1",S1,S2,0)=$$INC($GET(^TMP($JOB,"S1",S1,S2,0)),ND)
SET $PIECE(^(0),U,3)=$PIECE(ND50,U,9)
+3 IF S3'="ZZ"
SET X="^TMP($J,""S1"",S1,"_$SELECT('PSGP2:"S3",1:"S2,S3")_",0)"
SET @X=$$INC($GET(@X),ND)
+4 QUIT
+5 ;
INC(X,ND) ;Increment amount and cost.
+1 QUIT +X+$PIECE(ND,U,2)-$PIECE(ND,U,4)_U_($PIECE(X,U,2)+$PIECE(ND,U,3)-$PIECE(ND,U,5))
+2 ;
CLM ;
+1 WRITE !!?2,"Enter a number (dollar amount) to be the lower limit for this report. This number may be zero (0) to include all drugs with a positive cost. A NULL",!,"response will include all drugs. Enter an '^' to terminate this report."
QUIT
+2 ;
ALM ;
+1 WRITE !!?2,"Enter a number to be the lower dispensing limit (inclusive) for this report.",!,"This number may be zero (0) to include all drugs with a positive dispensing",!,"amount. A NULL response will include all drugs. Enter an '^' to "
+2 WRITE !,"terminate this report."
+3 QUIT
+4 ;
SDH ;
+1 WRITE !!?2,"Select a DRUG for which you wish to have cost data print."
+2 QUIT
+3 ;
SBCHK ;
+1 WRITE !!,"Enter '",$EXTRACT(PSGDCT(1),1),"' to have this report print the drugs in order of ",PSGDCT(2),".",!,"Enter 'C' to have this report print the drugs in descending order of TOTAL COST."
+2 WRITE !,"Enter 'A' to have this report print the drugs in descending order of the",!,"AMOUNT DISPENSED (in UNITS)."
SET PSGDCTS=""
+3 QUIT
+4 ;
ENQH ;
+1 WRITE !!,"Enter the category that the drugs on the report will be selected by...",!,"Enter 'D' for Dispensed Drug",!,"Enter 'O' for Orderable Item",!,"Enter 'V' for VA Class...."
+2 QUIT
WDHLP ;
+1 WRITE !!,"Enter ""YES"" to include dispensing amounts and cost by ward.",!
+2 QUIT
