- PSDNMBA ;DOIFO/CMS - CSM Balance Adjustments ;18 Dec 02
- ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
- ;Reference to ^PSD(58.81 supported by IA #2808
- ;Reference to ^PSDRUG( supported by IA #221
- ;Reference to ^PSD(58.84 supported by IA #3485
- Q
- ;
- ST ;CS Monitoring OPTION ENTRY
- N PSDA,PSDIDIV,PSDPLOC,PSDCII,PSDED,PSDOUT,PSDDTN,PSDSD,PSDSITE,X,Y,%
- N DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC,%ZIS
- W !!,?5,"This report lists Drug Accountability Balance Adjustments"
- W !,?5,"made for the Inpatient Site Pharmacy Location(s) entered.",!!
- S PSDA=$O(^PSD(58.84,"B","BALANCE ADJUSTMENT",0))
- I 'PSDA W !!,"<< Drug Accountability Transaction Type, Balance Adjustment, not defined! >>" G END
- D INPS^PSDNMU I '$G(PSDIDIV)!($G(PSDOUT)) G END
- W ! S DIR("A")="Select 'ALL' "_$P(PSDIDIV,U,2)_" Pharmacy locations"
- S DIR("B")="Yes",DIR(0)="Y" D ^DIR I X="^"!($D(DTOUT)) G END
- I Y'=1 W ! D PLOC^PSDNMU I '$O(PSDPLOC(0))!($G(PSDOUT)) G END
- I Y=1 D PLOCA^PSDNMU
- ;
- S PSDDTN="Balance Adjustment" D DATE^PSDNMU I '$G(PSDSD)!($G(PSDOUT)) G END
- W ! K DIR S DIR("A")="Okay to Continue",DIR("B")="No",DIR(0)="Y" D ^DIR
- I Y'=1 W " <No report>",! G END
- W !!,?9,"This report should be queued to run during non-peak hours.",!
- K IO("Q") S %ZIS="MQ" D ^%ZIS I POP W " <No device selected.>" G END
- I $D(IO("Q")) D
- .S ZTRTN="DQ^PSDNMBA",ZTDESC="CS Monitoring - PSDNMBA"
- .S ZTSAVE("PSDSD")="",ZTSAVE("PSDPLOC(")="",ZTSAVE("PSDED")="",ZTSAVE("PSDIDIV")=""
- .D ^%ZTLOAD W !!?5,"TASK #",$G(ZTSK)," QUEUED!",!
- I '$D(IO("Q")) U IO D DQ
- K IOP,IO("Q")
- END Q
- ;
- HD ;Report heading
- N PSDY,X,Y,%
- W @IOF,$$CJ^XLFSTR("CS Monitoring - Balance Adjustments Report",IOM)
- S PSDY="Inpatient site: "_$P(PSDIDIV,U,2)
- I $G(PSDPLOC)="^ALL" S PSDY=PSDY_" all Pharmacy Locations"
- W !,$$CJ^XLFSTR(PSDY,IOM)
- W !,$$CJ^XLFSTR("Balance Adjustments made: "_$P(PSDSD,U,2)_" thru "_$P(PSDED,U,2),IOM)
- S PSDPG=PSDPG+1
- D NOW^%DTC W !,"Report Run: "_$E($$FMTE^XLFDT(%),1,18),?70,"PAGE: ",PSDPG
- W !,$$REPEAT^XLFSTR("=",IOM)
- QUIT
- ;
- DQ ;Report Run
- N DFN,PSDA,PSDFD,PSDI,PSDIDT,PSDIV,PSDOUT,PSDP,PSDPG,PSDS,PSDRG,PSDUZ
- N PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,Y,%
- K ^TMP("PSDNMBA",$J)
- I IOST?1"C-".E W !!,?10,"Compiling report, please wait ..."
- S PSDA=$O(^PSD(58.84,"B","BALANCE ADJUSTMENT",0)) I 'PSDA G DQQ
- S PSDP=0
- F S PSDP=$O(PSDPLOC(PSDP)) Q:'PSDP S ^TMP("PSDNMBA",$J,PSDPLOC(PSDP))=""
- S PSDFD=+PSDSD
- F S PSDFD=$O(^PSD(58.81,"AF",PSDFD)) Q:('PSDFD)!(PSDFD]+PSDED) D
- . S PSDP=0
- . F S PSDP=$O(PSDPLOC(PSDP)) Q:'PSDP D
- . . S PSDX=0
- . . F S PSDX=$O(^PSD(58.81,"AF",PSDFD,PSDP,PSDA,PSDX)) Q:'PSDX D
- . . . S PSDX0=$G(^PSD(58.81,PSDX,0)) I PSDX0']"" Q
- . . . S PSDRG=$G(^PSDRUG(+$P(PSDX0,U,5),0))
- . . . S PSDUZ=+$P(PSDX0,U,7),PSDUZ=$P($G(^VA(200,+PSDUZ,0)),U,1)
- . . . S Y=PSDFD D D^DIQ S PSDS=Y
- . . . S ^TMP("PSDNMBA",$J,PSDPLOC(PSDP),PSDUZ,PSDX)=$P(PSDX0,U,1)_U_$E(PSDS,1,18)_U_$P(PSDX0,U,6)_U_$P(PSDRG,U,1)_U_$P(PSDX0,U,16)
- ;
- PRT ;Report print
- S PSDPG=0,PSDOUT=0
- I '$D(^TMP("PSDNMBA",$J)) D G DQQ
- . S PSDIV="",PSDPG=1 D HD,PHD
- . W !!,?10,"<<<< NO DATA FOUND >>>>",!
- S PSDIV=""
- D HD,PHD
- F S PSDIV=$O(^TMP("PSDNMBA",$J,PSDIV)) Q:(PSDIV="")!(PSDOUT) D
- . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . W !!,"Pharmacy Location: ",PSDIV
- . S PSDS=""
- . I $O(^TMP("PSDNMBA",$J,PSDIV,PSDS))']"" W !,?19,"NO DATA FOUND" Q
- . F S PSDS=$O(^TMP("PSDNMBA",$J,PSDIV,PSDS)) Q:(PSDS="")!(PSDOUT) D
- . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . . W !!,"TRANSACTOR: ",PSDS
- . . S PSDX=0
- . . F S PSDX=$O(^TMP("PSDNMBA",$J,PSDIV,PSDS,PSDX)) Q:('PSDX)!(PSDOUT) D
- . . . S PSDY=$G(^TMP("PSDNMBA",$J,PSDIV,PSDS,PSDX))
- . . . I ($Y+3)>IOSL D PAGE Q:PSDOUT D HD,PHD
- . . . W !,$P(PSDY,U,1),?10,$P(PSDY,U,2),?33,$P(PSDY,U,3),?40,$P(PSDY,U,4)
- . . . W !,?10,"Reason: ",$P(PSDY,U,5)
- ;
- DQQ W ! K PSDCII,PSDIDIV,PSDPLOC,PSDSD,PSDED,^TMP("PSDNMBA",$J) D ^%ZISC Q
- ;
- PHD ;
- W !,"Trans. #",?10,"Date",?28,"Quantity",?40,"Drug"
- W !,$$REPEAT^XLFSTR("_",IOM)
- Q
- PAGE ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- I IOST?1"C-".E S DIR(0)="E" D ^DIR W !
- I ($D(DTOUT))!($D(DIRUT)) S PSDOUT=1 Q:$G(PSDOUT)=1
- Q
- ;
- EOR ;PSDNMBA - CSM Balance Adjustments; 18 DEC 02
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNMBA 4264 printed Feb 18, 2025@23:13:16 Page 2
- PSDNMBA ;DOIFO/CMS - CSM Balance Adjustments ;18 Dec 02
- +1 ;;3.0; CONTROLLED SUBSTANCES ;*41*;13 Feb 97
- +2 ;Reference to ^PSD(58.81 supported by IA #2808
- +3 ;Reference to ^PSDRUG( supported by IA #221
- +4 ;Reference to ^PSD(58.84 supported by IA #3485
- +5 QUIT
- +6 ;
- ST ;CS Monitoring OPTION ENTRY
- +1 NEW PSDA,PSDIDIV,PSDPLOC,PSDCII,PSDED,PSDOUT,PSDDTN,PSDSD,PSDSITE,X,Y,%
- +2 NEW DIC,DIR,DIRUT,DIROUT,DTOUT,DUOUT,POP,ZTIO,ZTSAVE,ZTSK,ZTRTN,ZTDESC,%ZIS
- +3 WRITE !!,?5,"This report lists Drug Accountability Balance Adjustments"
- +4 WRITE !,?5,"made for the Inpatient Site Pharmacy Location(s) entered.",!!
- +5 SET PSDA=$ORDER(^PSD(58.84,"B","BALANCE ADJUSTMENT",0))
- +6 IF 'PSDA
- WRITE !!,"<< Drug Accountability Transaction Type, Balance Adjustment, not defined! >>"
- GOTO END
- +7 DO INPS^PSDNMU
- IF '$GET(PSDIDIV)!($GET(PSDOUT))
- GOTO END
- +8 WRITE !
- SET DIR("A")="Select 'ALL' "_$PIECE(PSDIDIV,U,2)_" Pharmacy locations"
- +9 SET DIR("B")="Yes"
- SET DIR(0)="Y"
- DO ^DIR
- IF X="^"!($DATA(DTOUT))
- GOTO END
- +10 IF Y'=1
- WRITE !
- DO PLOC^PSDNMU
- IF '$ORDER(PSDPLOC(0))!($GET(PSDOUT))
- GOTO END
- +11 IF Y=1
- DO PLOCA^PSDNMU
- +12 ;
- +13 SET PSDDTN="Balance Adjustment"
- DO DATE^PSDNMU
- IF '$GET(PSDSD)!($GET(PSDOUT))
- GOTO END
- +14 WRITE !
- KILL DIR
- SET DIR("A")="Okay to Continue"
- SET DIR("B")="No"
- SET DIR(0)="Y"
- DO ^DIR
- +15 IF Y'=1
- WRITE " <No report>",!
- GOTO END
- +16 WRITE !!,?9,"This report should be queued to run during non-peak hours.",!
- +17 KILL IO("Q")
- SET %ZIS="MQ"
- DO ^%ZIS
- IF POP
- WRITE " <No device selected.>"
- GOTO END
- +18 IF $DATA(IO("Q"))
- Begin DoDot:1
- +19 SET ZTRTN="DQ^PSDNMBA"
- SET ZTDESC="CS Monitoring - PSDNMBA"
- +20 SET ZTSAVE("PSDSD")=""
- SET ZTSAVE("PSDPLOC(")=""
- SET ZTSAVE("PSDED")=""
- SET ZTSAVE("PSDIDIV")=""
- +21 DO ^%ZTLOAD
- WRITE !!?5,"TASK #",$GET(ZTSK)," QUEUED!",!
- End DoDot:1
- +22 IF '$DATA(IO("Q"))
- USE IO
- DO DQ
- +23 KILL IOP,IO("Q")
- END QUIT
- +1 ;
- HD ;Report heading
- +1 NEW PSDY,X,Y,%
- +2 WRITE @IOF,$$CJ^XLFSTR("CS Monitoring - Balance Adjustments Report",IOM)
- +3 SET PSDY="Inpatient site: "_$PIECE(PSDIDIV,U,2)
- +4 IF $GET(PSDPLOC)="^ALL"
- SET PSDY=PSDY_" all Pharmacy Locations"
- +5 WRITE !,$$CJ^XLFSTR(PSDY,IOM)
- +6 WRITE !,$$CJ^XLFSTR("Balance Adjustments made: "_$PIECE(PSDSD,U,2)_" thru "_$PIECE(PSDED,U,2),IOM)
- +7 SET PSDPG=PSDPG+1
- +8 DO NOW^%DTC
- WRITE !,"Report Run: "_$EXTRACT($$FMTE^XLFDT(%),1,18),?70,"PAGE: ",PSDPG
- +9 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +10 QUIT
- +11 ;
- DQ ;Report Run
- +1 NEW DFN,PSDA,PSDFD,PSDI,PSDIDT,PSDIV,PSDOUT,PSDP,PSDPG,PSDS,PSDRG,PSDUZ
- +2 NEW PSDX,PSDX0,PSDX2,PSDXOR1,PSDY,X,Y,%
- +3 KILL ^TMP("PSDNMBA",$JOB)
- +4 IF IOST?1"C-".E
- WRITE !!,?10,"Compiling report, please wait ..."
- +5 SET PSDA=$ORDER(^PSD(58.84,"B","BALANCE ADJUSTMENT",0))
- IF 'PSDA
- GOTO DQQ
- +6 SET PSDP=0
- +7 FOR
- SET PSDP=$ORDER(PSDPLOC(PSDP))
- if 'PSDP
- QUIT
- SET ^TMP("PSDNMBA",$JOB,PSDPLOC(PSDP))=""
- +8 SET PSDFD=+PSDSD
- +9 FOR
- SET PSDFD=$ORDER(^PSD(58.81,"AF",PSDFD))
- if ('PSDFD)!(PSDFD]+PSDED)
- QUIT
- Begin DoDot:1
- +10 SET PSDP=0
- +11 FOR
- SET PSDP=$ORDER(PSDPLOC(PSDP))
- if 'PSDP
- QUIT
- Begin DoDot:2
- +12 SET PSDX=0
- +13 FOR
- SET PSDX=$ORDER(^PSD(58.81,"AF",PSDFD,PSDP,PSDA,PSDX))
- if 'PSDX
- QUIT
- Begin DoDot:3
- +14 SET PSDX0=$GET(^PSD(58.81,PSDX,0))
- IF PSDX0']""
- QUIT
- +15 SET PSDRG=$GET(^PSDRUG(+$PIECE(PSDX0,U,5),0))
- +16 SET PSDUZ=+$PIECE(PSDX0,U,7)
- SET PSDUZ=$PIECE($GET(^VA(200,+PSDUZ,0)),U,1)
- +17 SET Y=PSDFD
- DO D^DIQ
- SET PSDS=Y
- +18 SET ^TMP("PSDNMBA",$JOB,PSDPLOC(PSDP),PSDUZ,PSDX)=$PIECE(PSDX0,U,1)_U_$EXTRACT(PSDS,1,18)_U_$PIECE(PSDX0,U,6)_U_$PIECE(PSDRG,U,1)_U_$PIECE(PSDX0,U,16)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 ;
- PRT ;Report print
- +1 SET PSDPG=0
- SET PSDOUT=0
- +2 IF '$DATA(^TMP("PSDNMBA",$JOB))
- Begin DoDot:1
- +3 SET PSDIV=""
- SET PSDPG=1
- DO HD
- DO PHD
- +4 WRITE !!,?10,"<<<< NO DATA FOUND >>>>",!
- End DoDot:1
- GOTO DQQ
- +5 SET PSDIV=""
- +6 DO HD
- DO PHD
- +7 FOR
- SET PSDIV=$ORDER(^TMP("PSDNMBA",$JOB,PSDIV))
- if (PSDIV="")!(PSDOUT)
- QUIT
- Begin DoDot:1
- +8 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +9 WRITE !!,"Pharmacy Location: ",PSDIV
- +10 SET PSDS=""
- +11 IF $ORDER(^TMP("PSDNMBA",$JOB,PSDIV,PSDS))']""
- WRITE !,?19,"NO DATA FOUND"
- QUIT
- +12 FOR
- SET PSDS=$ORDER(^TMP("PSDNMBA",$JOB,PSDIV,PSDS))
- if (PSDS="")!(PSDOUT)
- QUIT
- Begin DoDot:2
- +13 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +14 WRITE !!,"TRANSACTOR: ",PSDS
- +15 SET PSDX=0
- +16 FOR
- SET PSDX=$ORDER(^TMP("PSDNMBA",$JOB,PSDIV,PSDS,PSDX))
- if ('PSDX)!(PSDOUT)
- QUIT
- Begin DoDot:3
- +17 SET PSDY=$GET(^TMP("PSDNMBA",$JOB,PSDIV,PSDS,PSDX))
- +18 IF ($Y+3)>IOSL
- DO PAGE
- if PSDOUT
- QUIT
- DO HD
- DO PHD
- +19 WRITE !,$PIECE(PSDY,U,1),?10,$PIECE(PSDY,U,2),?33,$PIECE(PSDY,U,3),?40,$PIECE(PSDY,U,4)
- +20 WRITE !,?10,"Reason: ",$PIECE(PSDY,U,5)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 ;
- DQQ WRITE !
- KILL PSDCII,PSDIDIV,PSDPLOC,PSDSD,PSDED,^TMP("PSDNMBA",$JOB)
- DO ^%ZISC
- QUIT
- +1 ;
- PHD ;
- +1 WRITE !,"Trans. #",?10,"Date",?28,"Quantity",?40,"Drug"
- +2 WRITE !,$$REPEAT^XLFSTR("_",IOM)
- +3 QUIT
- PAGE ;
- +1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +2 IF IOST?1"C-".E
- SET DIR(0)="E"
- DO ^DIR
- WRITE !
- +3 IF ($DATA(DTOUT))!($DATA(DIRUT))
- SET PSDOUT=1
- if $GET(PSDOUT)=1
- QUIT
- +4 QUIT
- +5 ;
- EOR ;PSDNMBA - CSM Balance Adjustments; 18 DEC 02