- PSSADRPT ;BIR/RTR-IV ADDITIVE REPORT ;07/15/09
- ;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
- ;
- REP ;IV Additive report
- ;
- W !!,"This report displays entries in the IV ADDITIVES (#52.6) File. You can select",!,"to display only entries marked with '1 BAG/DAY' in the ADDITIVE FREQUENCY (#18)"
- W !,"Field, or only those entries with nothing entered in the ADDITIVE FREQUENCY",!,"(#18) Field, or all entries can be displayed.",!
- N DIR,PSSKFTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- K DIR,Y S DIR(0)="SO^1:Print entries marked as '1 BAG/DAY' for ADDITIVE FREQUENCY;N:Print entries marked as Null for ADDITIVE FREQUENCY;A:Print all IV Additives"
- S DIR("B")="A",DIR("A")="Print which IV Additives"
- S DIR("?")=" ",DIR("?",1)="Enter '1' to see only those IV Additives that are marked as '1 BAG/DAY' in"
- S DIR("?",2)="the ADDITIVE FREQUENCY (#18) Field, enter 'N' to see only those IV Additives"
- S DIR("?",3)="with no data entered in the ADDITIVE FREQUENCY (#18) Field, enter 'A' to"
- S DIR("?",4)="see all IV Additives, regardless of ADDITIVE FREQUENCY designation."
- D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS Q
- I Y'="1",Y'="N",Y'="A" D MESS Q
- S PSSKFTP=Y
- W !!?3,"This report is designed for 80 column format!",!
- K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 W !!,"Nothing queued to print.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,IOP,%ZIS,POP Q
- I $D(IO("Q")) S ZTRTN="START^PSSADRPT",ZTDESC="IV Additives Report",ZTSAVE("PSSKFTP")="" D ^%ZTLOAD W !!,"Report queued to print.",! D K IOP,%ZIS,POP Q
- .K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- ;
- U IO G STARTX
- START ;
- U IO
- N DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
- STARTX ;
- N PSSKFOUT,PSSKFMDV,PSSKFMFD,PSSKFMCT,PSSKFMLN,PSSKFMXX,PSSKFMIN,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3,PSSKFMTP,PSSKFERR,PSSKFERZ,PSSKFERX
- S (PSSKFOUT,PSSKFMFD)=0,PSSKFMDV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSKFMCT=1
- K PSSKFMLN S $P(PSSKFMLN,"-",79)=""
- D HD
- S PSSKFMXX="" F S PSSKFMXX=$O(^PS(52.6,"B",PSSKFMXX)) Q:PSSKFMXX=""!(PSSKFOUT) D
- .F PSSKFMIN=0:0 S PSSKFMIN=$O(^PS(52.6,"B",PSSKFMXX,PSSKFMIN)) Q:'PSSKFMIN!(PSSKFOUT) D
- ..K PSSKFMTP,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFML3
- ..S PSSKFMTP=PSSKFMIN_","
- ..D GETS^DIQ(52.6,PSSKFMTP,".01;1;2;12;15;17;18","IE","PSSKFMAR","PSSKFERR")
- ..I PSSKFTP=1,$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=1 Q
- ..I PSSKFTP="N",$G(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'="" Q
- ..S PSSKFMFD=1
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !!?18,"Print Name: "_$G(PSSKFMAR(52.6,PSSKFMTP,.01,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !?19,"Drug Unit: "_$G(PSSKFMAR(52.6,PSSKFMTP,2,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !?20,"Synonyms: "
- ..S PSSKFMSC=0 F PSSKFMSY=0:0 S PSSKFMSY=$O(^PS(52.6,PSSKFMIN,3,PSSKFMSY)) Q:'PSSKFMSY!(PSSKFOUT) D
- ...K PSSKFMSU,PSSKFMSX
- ...S PSSKFMSU=PSSKFMSY_","_PSSKFMIN_"," S PSSKFMSX=$$GET1^DIQ(52.63,PSSKFMSU,".01",,,"PSSKFERX")
- ...W:PSSKFMSC !?30,$G(PSSKFMSX) W:'PSSKFMSC ?30,$G(PSSKFMSX)
- ...S PSSKFMSC=1
- ...I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..Q:PSSKFOUT
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !?16,"Generic Drug: "_$G(PSSKFMAR(52.6,PSSKFMTP,1,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..K PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3
- ..S PSSKFML1=$L($G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))),PSSKFMDF=$G(PSSKFMAR(52.6,PSSKFMTP,15,"I"))
- ..S PSSKFML2=0 I PSSKFMDF S PSSKFMDZ=PSSKFMDF_"," S PSSKFMDQ=$$GET1^DIQ(50.7,PSSKFMDZ,".02",,,"PSSKFERZ") S PSSKFML2=$L(PSSKFMDQ)
- ..S PSSKFML3=PSSKFML1+PSSKFML2
- ..W !?5,"Pharmacy Orderable Item: "_$G(PSSKFMAR(52.6,PSSKFMTP,15,"E"))
- ..I PSSKFML3<47 W " "_$G(PSSKFMDQ)
- ..I PSSKFML3'<47 W !?30,$G(PSSKFMDQ)
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !?11,"Inactivation Date: "_$G(PSSKFMAR(52.6,PSSKFMTP,12,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !,"Used in IV Fluid Order Entry: "_$G(PSSKFMAR(52.6,PSSKFMTP,17,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ..W !?10,"Additive Frequency: "_$G(PSSKFMAR(52.6,PSSKFMTP,18,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSKFOUT
- ;
- END ;End of report
- I '$G(PSSKFOUT),'$G(PSSKFMFD) W !!,$S($G(PSSKFTP)=1:"No IV Additives marked as '1 BAG/DAY'.",$G(PSSKFTP)="N":"No IV Additives marked as null.",1:"No IV Additives to print."),!
- I $G(PSSKFMDV)="P" W !!,"End of Report.",!
- K PSSKFTP
- I '$G(PSSKFOUT),$G(PSSKFMDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- I $G(PSSKFMDV)="C" W !
- E W @IOF
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- HD ;Report Header
- I $G(PSSKFMDV)="C",$G(PSSKFMCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSKFOUT=1 Q
- W @IOF W !,$S(PSSKFTP=1:"IV Additives marked as '1 BAG/DAY' for ADDITIVE FREQUENCY",PSSKFTP="N":"IV Additives marked as null for ADDITIVE FREQUENCY",1:"All IV Additives"),?68,"Page: "_$G(PSSKFMCT),!,PSSKFMLN,! S PSSKFMCT=PSSKFMCT+1
- Q
- ;
- MESS ;
- W !!,"No Action taken.",!
- K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSADRPT 5120 printed Feb 18, 2025@23:56:25 Page 2
- PSSADRPT ;BIR/RTR-IV ADDITIVE REPORT ;07/15/09
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**147**;9/30/97;Build 16
- +2 ;
- REP ;IV Additive report
- +1 ;
- +2 WRITE !!,"This report displays entries in the IV ADDITIVES (#52.6) File. You can select",!,"to display only entries marked with '1 BAG/DAY' in the ADDITIVE FREQUENCY (#18)"
- +3 WRITE !,"Field, or only those entries with nothing entered in the ADDITIVE FREQUENCY",!,"(#18) Field, or all entries can be displayed.",!
- +4 NEW DIR,PSSKFTP,Y,DIRUT,DIROUT,DUOUT,DTOUT,IOP,%ZIS,POP,X,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- +5 KILL DIR,Y
- SET DIR(0)="SO^1:Print entries marked as '1 BAG/DAY' for ADDITIVE FREQUENCY;N:Print entries marked as Null for ADDITIVE FREQUENCY;A:Print all IV Additives"
- +6 SET DIR("B")="A"
- SET DIR("A")="Print which IV Additives"
- +7 SET DIR("?")=" "
- SET DIR("?",1)="Enter '1' to see only those IV Additives that are marked as '1 BAG/DAY' in"
- +8 SET DIR("?",2)="the ADDITIVE FREQUENCY (#18) Field, enter 'N' to see only those IV Additives"
- +9 SET DIR("?",3)="with no data entered in the ADDITIVE FREQUENCY (#18) Field, enter 'A' to"
- +10 SET DIR("?",4)="see all IV Additives, regardless of ADDITIVE FREQUENCY designation."
- +11 DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!($DATA(DTOUT))
- DO MESS
- QUIT
- +12 IF Y'="1"
- IF Y'="N"
- IF Y'="A"
- DO MESS
- QUIT
- +13 SET PSSKFTP=Y
- +14 WRITE !!?3,"This report is designed for 80 column format!",!
- +15 KILL IOP,%ZIS,POP
- SET %ZIS="QM"
- DO ^%ZIS
- IF $GET(POP)>0
- WRITE !!,"Nothing queued to print.",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,IOP,%ZIS,POP
- QUIT
- +16 IF $DATA(IO("Q"))
- SET ZTRTN="START^PSSADRPT"
- SET ZTDESC="IV Additives Report"
- SET ZTSAVE("PSSKFTP")=""
- DO ^%ZTLOAD
- WRITE !!,"Report queued to print.",!
- Begin DoDot:1
- +17 KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- KILL IOP,%ZIS,POP
- QUIT
- +18 ;
- +19 USE IO
- GOTO STARTX
- START ;
- +1 USE IO
- +2 NEW DIR,Y,DIRUT,DIROUT,DUOUT,DTOUT,X
- STARTX ;
- +1 NEW PSSKFOUT,PSSKFMDV,PSSKFMFD,PSSKFMCT,PSSKFMLN,PSSKFMXX,PSSKFMIN,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3,PSSKFMTP,PSSKFERR,PSSKFERZ,PSSKFERX
- +2 SET (PSSKFOUT,PSSKFMFD)=0
- SET PSSKFMDV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
- SET PSSKFMCT=1
- +3 KILL PSSKFMLN
- SET $PIECE(PSSKFMLN,"-",79)=""
- +4 DO HD
- +5 SET PSSKFMXX=""
- FOR
- SET PSSKFMXX=$ORDER(^PS(52.6,"B",PSSKFMXX))
- if PSSKFMXX=""!(PSSKFOUT)
- QUIT
- Begin DoDot:1
- +6 FOR PSSKFMIN=0:0
- SET PSSKFMIN=$ORDER(^PS(52.6,"B",PSSKFMXX,PSSKFMIN))
- if 'PSSKFMIN!(PSSKFOUT)
- QUIT
- Begin DoDot:2
- +7 KILL PSSKFMTP,PSSKFMAR,PSSKFMSC,PSSKFMSY,PSSKFMSU,PSSKFMSX,PSSKFML1,PSSKFML2,PSSKFML3
- +8 SET PSSKFMTP=PSSKFMIN_","
- +9 DO GETS^DIQ(52.6,PSSKFMTP,".01;1;2;12;15;17;18","IE","PSSKFMAR","PSSKFERR")
- +10 IF PSSKFTP=1
- IF $GET(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=1
- QUIT
- +11 IF PSSKFTP="N"
- IF $GET(PSSKFMAR(52.6,PSSKFMTP,18,"I"))'=""
- QUIT
- +12 SET PSSKFMFD=1
- +13 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +14 WRITE !!?18,"Print Name: "_$GET(PSSKFMAR(52.6,PSSKFMTP,.01,"E"))
- +15 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +16 WRITE !?19,"Drug Unit: "_$GET(PSSKFMAR(52.6,PSSKFMTP,2,"E"))
- +17 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +18 WRITE !?20,"Synonyms: "
- +19 SET PSSKFMSC=0
- FOR PSSKFMSY=0:0
- SET PSSKFMSY=$ORDER(^PS(52.6,PSSKFMIN,3,PSSKFMSY))
- if 'PSSKFMSY!(PSSKFOUT)
- QUIT
- Begin DoDot:3
- +20 KILL PSSKFMSU,PSSKFMSX
- +21 SET PSSKFMSU=PSSKFMSY_","_PSSKFMIN_","
- SET PSSKFMSX=$$GET1^DIQ(52.63,PSSKFMSU,".01",,,"PSSKFERX")
- +22 if PSSKFMSC
- WRITE !?30,$GET(PSSKFMSX)
- if 'PSSKFMSC
- WRITE ?30,$GET(PSSKFMSX)
- +23 SET PSSKFMSC=1
- +24 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- End DoDot:3
- +25 if PSSKFOUT
- QUIT
- +26 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +27 WRITE !?16,"Generic Drug: "_$GET(PSSKFMAR(52.6,PSSKFMTP,1,"E"))
- +28 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +29 KILL PSSKFML1,PSSKFML2,PSSKFMDF,PSSKFMDZ,PSSKFMDQ,PSSKFML3
- +30 SET PSSKFML1=$LENGTH($GET(PSSKFMAR(52.6,PSSKFMTP,15,"E")))
- SET PSSKFMDF=$GET(PSSKFMAR(52.6,PSSKFMTP,15,"I"))
- +31 SET PSSKFML2=0
- IF PSSKFMDF
- SET PSSKFMDZ=PSSKFMDF_","
- SET PSSKFMDQ=$$GET1^DIQ(50.7,PSSKFMDZ,".02",,,"PSSKFERZ")
- SET PSSKFML2=$LENGTH(PSSKFMDQ)
- +32 SET PSSKFML3=PSSKFML1+PSSKFML2
- +33 WRITE !?5,"Pharmacy Orderable Item: "_$GET(PSSKFMAR(52.6,PSSKFMTP,15,"E"))
- +34 IF PSSKFML3<47
- WRITE " "_$GET(PSSKFMDQ)
- +35 IF PSSKFML3'<47
- WRITE !?30,$GET(PSSKFMDQ)
- +36 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +37 WRITE !?11,"Inactivation Date: "_$GET(PSSKFMAR(52.6,PSSKFMTP,12,"E"))
- +38 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +39 WRITE !,"Used in IV Fluid Order Entry: "_$GET(PSSKFMAR(52.6,PSSKFMTP,17,"E"))
- +40 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- +41 WRITE !?10,"Additive Frequency: "_$GET(PSSKFMAR(52.6,PSSKFMTP,18,"E"))
- +42 IF ($Y+5)>IOSL
- DO HD
- if PSSKFOUT
- QUIT
- End DoDot:2
- End DoDot:1
- +43 ;
- END ;End of report
- +1 IF '$GET(PSSKFOUT)
- IF '$GET(PSSKFMFD)
- WRITE !!,$SELECT($GET(PSSKFTP)=1:"No IV Additives marked as '1 BAG/DAY'.",$GET(PSSKFTP)="N":"No IV Additives marked as null.",1:"No IV Additives to print."),!
- +2 IF $GET(PSSKFMDV)="P"
- WRITE !!,"End of Report.",!
- +3 KILL PSSKFTP
- +4 IF '$GET(PSSKFOUT)
- IF $GET(PSSKFMDV)="C"
- WRITE !!,"End of Report."
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +5 IF $GET(PSSKFMDV)="C"
- WRITE !
- +6 IF '$TEST
- WRITE @IOF
- +7 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +8 QUIT
- +9 ;
- HD ;Report Header
- +1 IF $GET(PSSKFMDV)="C"
- IF $GET(PSSKFMCT)'=1
- WRITE !
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue, '^' to exit"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSSKFOUT=1
- QUIT
- +2 WRITE @IOF
- WRITE !,$SELECT(PSSKFTP=1:"IV Additives marked as '1 BAG/DAY' for ADDITIVE FREQUENCY",PSSKFTP="N":"IV Additives marked as null for ADDITIVE FREQUENCY",1:"All IV Additives"),?68,"Page: "_$GET(PSSKFMCT),!,PSSKFMLN,!
- SET PSSKFMCT=PSSKFMCT+1
- +3 QUIT
- +4 ;
- MESS ;
- +1 WRITE !!,"No Action taken.",!
- +2 KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +3 QUIT