- PSSIIRPT ;BIR/JCH-Infusion Instruction Report ;10/26/12
- ;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/07;Build 28
- ;
- ;
- EN ;Prompts for Infusion Instruction File Report
- W !!,"This report displays entries from the INFUSION INSTRUCTION (#53.47) File."
- ;
- N DIR,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- K DIR,Y S DIR(0)="SO^80:80 Column;132:132 Column",DIR("A")="Print report in 80 or 132 column format",DIR("B")="80"
- S DIR("?")=" ",DIR("?",1)="Enter 80 to print the report in an 80 column format,",DIR("?",2)="Enter 132 to print the report in an 132 column format."
- W ! D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- I Y'="80",Y'="132" D MESS K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
- S PSSMXLNG=Y W !
- K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP)>0 D MESS K DIR,Y 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^PSSIIRPT",ZTDESC="Infusion Instruction File Report",ZTSAVE("PSSMXLNG")="" D ^%ZTLOAD K %ZIS W !!,"Report queued to print.",! D Q
- .K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- ;
- ;
- START ;Print Medication Instruction File report
- U IO
- N PSSMXOUT,PSSMXNOF,PSSMXDEV,PSSMXCT,PSSMXLIN,PSSMXQ,PSSMXQEN,PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
- S (PSSMXOUT,PSSMXNOF)=0,PSSMXDEV=$S($E(IOST,1,2)'="C-":"P",1:"C"),PSSMXCT=1
- K PSSMXLIN S:PSSMXLNG=132 $P(PSSMXLIN,"-",130)="" S:PSSMXLNG=80 $P(PSSMXLIN,"-",78)=""
- D HD
- S PSSMXQ="" F S PSSMXQ=$O(^PS(53.47,"B",PSSMXQ)) Q:PSSMXQ=""!(PSSMXOUT) D
- .F PSSMXQEN=0:0 S PSSMXQEN=$O(^PS(53.47,"B",PSSMXQ,PSSMXQEN)) Q:'PSSMXQEN!(PSSMXOUT) I '$G(^PS(53.47,"B",PSSMXQ,PSSMXQEN)) D
- ..K PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
- ..S PSSMXRA=PSSMXQEN_","
- ..D GETS^DIQ(53.47,PSSMXRA,".01;1","E","PSSMXRAA")
- ..S PSSMXNOF=1
- ..W !!,$G(PSSMXRAA(53.47,PSSMXRA,.01,"E"))
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT
- ..W !?17,"EXPANSION: " D
- ...S PSSMXREP=$G(PSSMXRAA(53.47,PSSMXRA,1,"E"))
- ...I PSSMXLNG=132 D Q
- ....I $L(PSSMXREP)<104 W PSSMXREP,! Q
- ....N X,DIWL,DIWR,DIWF S X=PSSMXREP,DIWL=29,DIWR=131,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
- ...I $L(PSSMXREP)<52 W PSSMXREP,! Q
- ...N X,DIWL,DIWR,DIWF S X=PSSMXREP,DIWL=29,DIWR=79,DIWF="W" K ^UTILITY($J,"W") D ^DIWP D ^DIWW K ^UTILITY($J,"W")
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT W !
- ..I ($Y+5)>IOSL D HD Q:PSSMXOUT W !
- ;
- END ;
- I $G(PSSMXDEV)="P" W !!,"End of Report.",!
- I '$G(PSSMXOUT),$G(PSSMXDEV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- I $G(PSSMXDEV)="C" W !
- E W @IOF
- K PSSMXLNG
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- ;
- HD ;Report Header
- I $G(PSSMXDEV)="C",$G(PSSMXCT)'=1 W ! K DIR,Y S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSMXOUT=1 Q
- W @IOF
- W !,"INFUSION INSTRUCTION FILE REPORT"
- W ?$S(PSSMXLNG=80:68,1:120),"PAGE: "_PSSMXCT,!,PSSMXLIN,! S PSSMXCT=PSSMXCT+1
- Q
- ;
- MESS ;
- W !!,"Nothing queued to print.",!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSIIRPT 3104 printed Feb 18, 2025@23:58:07 Page 2
- PSSIIRPT ;BIR/JCH-Infusion Instruction Report ;10/26/12
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**172**;9/30/07;Build 28
- +2 ;
- +3 ;
- EN ;Prompts for Infusion Instruction File Report
- +1 WRITE !!,"This report displays entries from the INFUSION INSTRUCTION (#53.47) File."
- +2 ;
- +3 NEW DIR,PSSMXLNG,Y,X,DTOUT,DUOUT,DIRUT,DIROUT,IOP,%ZIS,POP,ZTRTN,ZTDESC,ZTSAVE,ZTSK
- +4 KILL DIR,Y
- SET DIR(0)="SO^80:80 Column;132:132 Column"
- SET DIR("A")="Print report in 80 or 132 column format"
- SET DIR("B")="80"
- +5 SET DIR("?")=" "
- SET DIR("?",1)="Enter 80 to print the report in an 80 column format,"
- SET DIR("?",2)="Enter 132 to print the report in an 132 column format."
- +6 WRITE !
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)!($DATA(DTOUT))
- DO MESS
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- +7 IF Y'="80"
- IF Y'="132"
- DO MESS
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- QUIT
- +8 SET PSSMXLNG=Y
- WRITE !
- +9 KILL IOP,%ZIS,POP
- SET %ZIS="QM"
- DO ^%ZIS
- IF $GET(POP)>0
- DO MESS
- KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR,IOP,%ZIS,POP
- QUIT
- +10 IF $DATA(IO("Q"))
- SET ZTRTN="START^PSSIIRPT"
- SET ZTDESC="Infusion Instruction File Report"
- SET ZTSAVE("PSSMXLNG")=""
- DO ^%ZTLOAD
- KILL %ZIS
- WRITE !!,"Report queued to print.",!
- Begin DoDot:1
- +11 KILL DIR,Y
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- End DoDot:1
- QUIT
- +12 ;
- +13 ;
- START ;Print Medication Instruction File report
- +1 USE IO
- +2 NEW PSSMXOUT,PSSMXNOF,PSSMXDEV,PSSMXCT,PSSMXLIN,PSSMXQ,PSSMXQEN,PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
- +3 SET (PSSMXOUT,PSSMXNOF)=0
- SET PSSMXDEV=$SELECT($EXTRACT(IOST,1,2)'="C-":"P",1:"C")
- SET PSSMXCT=1
- +4 KILL PSSMXLIN
- if PSSMXLNG=132
- SET $PIECE(PSSMXLIN,"-",130)=""
- if PSSMXLNG=80
- SET $PIECE(PSSMXLIN,"-",78)=""
- +5 DO HD
- +6 SET PSSMXQ=""
- FOR
- SET PSSMXQ=$ORDER(^PS(53.47,"B",PSSMXQ))
- if PSSMXQ=""!(PSSMXOUT)
- QUIT
- Begin DoDot:1
- +7 FOR PSSMXQEN=0:0
- SET PSSMXQEN=$ORDER(^PS(53.47,"B",PSSMXQ,PSSMXQEN))
- if 'PSSMXQEN!(PSSMXOUT)
- QUIT
- IF '$GET(^PS(53.47,"B",PSSMXQ,PSSMXQEN))
- Begin DoDot:2
- +8 KILL PSSMXRA,PSSMXRAA,PSSMXREP,PSSMXROO
- +9 SET PSSMXRA=PSSMXQEN_","
- +10 DO GETS^DIQ(53.47,PSSMXRA,".01;1","E","PSSMXRAA")
- +11 SET PSSMXNOF=1
- +12 WRITE !!,$GET(PSSMXRAA(53.47,PSSMXRA,.01,"E"))
- +13 IF ($Y+5)>IOSL
- DO HD
- if PSSMXOUT
- QUIT
- +14 WRITE !?17,"EXPANSION: "
- Begin DoDot:3
- +15 SET PSSMXREP=$GET(PSSMXRAA(53.47,PSSMXRA,1,"E"))
- +16 IF PSSMXLNG=132
- Begin DoDot:4
- +17 IF $LENGTH(PSSMXREP)<104
- WRITE PSSMXREP,!
- QUIT
- +18 NEW X,DIWL,DIWR,DIWF
- SET X=PSSMXREP
- SET DIWL=29
- SET DIWR=131
- SET DIWF="W"
- KILL ^UTILITY($JOB,"W")
- DO ^DIWP
- DO ^DIWW
- KILL ^UTILITY($JOB,"W")
- End DoDot:4
- QUIT
- +19 IF $LENGTH(PSSMXREP)<52
- WRITE PSSMXREP,!
- QUIT
- +20 NEW X,DIWL,DIWR,DIWF
- SET X=PSSMXREP
- SET DIWL=29
- SET DIWR=79
- SET DIWF="W"
- KILL ^UTILITY($JOB,"W")
- DO ^DIWP
- DO ^DIWW
- KILL ^UTILITY($JOB,"W")
- End DoDot:3
- +21 IF ($Y+5)>IOSL
- DO HD
- if PSSMXOUT
- QUIT
- WRITE !
- +22 IF ($Y+5)>IOSL
- DO HD
- if PSSMXOUT
- QUIT
- WRITE !
- End DoDot:2
- End DoDot:1
- +23 ;
- END ;
- +1 IF $GET(PSSMXDEV)="P"
- WRITE !!,"End of Report.",!
- +2 IF '$GET(PSSMXOUT)
- IF $GET(PSSMXDEV)="C"
- WRITE !!,"End of Report."
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +3 IF $GET(PSSMXDEV)="C"
- WRITE !
- +4 IF '$TEST
- WRITE @IOF
- +5 KILL PSSMXLNG
- +6 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +7 QUIT
- +8 ;
- HD ;Report Header
- +1 IF $GET(PSSMXDEV)="C"
- IF $GET(PSSMXCT)'=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 PSSMXOUT=1
- QUIT
- +2 WRITE @IOF
- +3 WRITE !,"INFUSION INSTRUCTION FILE REPORT"
- +4 WRITE ?$SELECT(PSSMXLNG=80:68,1:120),"PAGE: "_PSSMXCT,!,PSSMXLIN,!
- SET PSSMXCT=PSSMXCT+1
- +5 QUIT
- +6 ;
- MESS ;
- +1 WRITE !!,"Nothing queued to print.",!
- +2 QUIT
