- PSXLIST ;BIR/WPB-Report Routine to List Orders/Rx's in a Batch ;04/08/97 2:06 PM
- ;;2.0;CMOP;**38**;11 Apr 97
- EN1 ;prints order/rx data from 512 at host
- S DIC="^PSX(552.1,",DIC("S")="I ($P($G(^PSX(552.1,+Y,0)),U,4)'=""""),($D(^PSX(552.1,""AQ"",$P($G(^PSX(552.1,+Y,0)),U,4),$P($G(^PSX(552.1,+Y,0)),U,1),+Y)))",DIC(0)="AEQMZ" D ^DIC K DIC Q:Y'>0!($D(DTOUT)) S BAT=$P(Y,"^",2)
- K Y
- END S %ZIS="Q",%ZIS("B")="" D ^%ZIS S PSLION=ION I POP W !,"No Device Selected" G EXIT
- I $D(IO("Q")) D QUE G EX1
- D P512 G:$G(STOP) EX1 G EXIT
- Q
- QUE S ZTRTN="P512^PSXLIST",ZTDESC="CMOP Data Transmission Report",ZTSAVE("BAT")="",ZTSAVE("PSLION")="",ZTIO=PSLION D ^%ZTLOAD
- I $D(ZTSK)[0 W !!,"Job Canceled"
- E W !!,"Job Queued"
- D HOME^%ZIS
- Q
- ;Called by Taskman to list Rx's/orders in a batch
- P512 S:$D(ZTQUEUED) ZTREQ="@"
- U IO
- S RECD=$O(^PSX(552.1,"B",BAT,"")),SITEN=$P(BAT,"-",1)
- ;N X,Y S DIC=4,DIC(0)="MNZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=$S($G(Y)]"":$P(Y,"^",2),1:"UNKNOWN") ;****DOD L1
- N X,Y S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S SITE=$$IEN^XUMF(4,AGNCY,X),SITE=$S($G(SITE)]"":$$NAME^XUAF4(SITE),1:"UNKNOWN") ;****DOD L1
- S PHAR=$P(^PSX(552.1,RECD,"P"),U,1),X=$P(^PSX(552.1,RECD,0),U,4),TDTM=$$FMTE^XLFDT(X,"1P")
- S TOTRX=$P($G(^PSX(552.1,RECD,1)),U,4),TOTORD=$P($G(^PSX(552.1,RECD,1)),U,3)
- D SUB
- S OKAY=0,XX=0 F S XX=$O(^PSX(552.2,"AQ",BAT,XX)) Q:XX'>0 Q:$G(STOP) S ORDNUM=XX,ZZ=0 F S ZZ=$O(^PSX(552.2,XX,"T",ZZ)) Q:ZZ'>0 S NODE=$G(^PSX(552.2,XX,"T",ZZ,0)) D
- .Q:$G(STOP)
- .Q:$E(NODE,1,4)["MSH|"!($E(NODE,1,4)["NTE|")
- .I $E(NODE,1,4)["PID|" S NM=$P(NODE,"|",6),SS=$P($P(NODE,"|",4),"^",1),SSN=$E(SS,1,3)_"-"_$E(SS,4,5)_"-"_$E(SS,6,9),NAME=$P(NM,"^",1)_", "_$P(NM,"^",2)
- .I $E(NODE,1,4)["ORC|" S ZX=ZZ F S ZX=$O(^PSX(552.2,XX,"T",ZX)) Q:ZX'>0 S TNODE=$G(^PSX(552.2,XX,"T",ZX,0)) D
- ..Q:$G(STOP)
- ..Q:$E(TNODE,1,4)["NTE|"
- ..I $E(TNODE,1,4)["ORC|" S ZZ=ZX Q
- ..I $E(TNODE,1,4)["RX1|" S DRUGNUM=$P($P(TNODE,"|",15),"^",1),DRUGNM=$P($P(TNODE,"|",15),"^",2),ISSDATE=$P(TNODE,"|",21),EXDATE=$P(TNODE,"|",25),RXNUM=$P(TNODE,"|",27),IDATE=$E(ISSDATE,5,6)_"/"_$E(ISSDATE,7,8)_"/"_$E(ISSDATE,3,4) D Q
- ...S EDATE=$E(EXDATE,5,6)_"/"_$E(EXDATE,7,8)_"/"_$E(EXDATE,3,4)
- ..I $E(TNODE,1,4)["ZX1|" S OKAY=1,BAR=$P(TNODE,"|",16) D LIST Q
- Q
- EXIT I $G(IOST)["C-" S DIR(0)="E",DIR("A")="Press RETURN to continue " D ^DIR K DIR W @IOF
- EX1 K IDATE,EDATE,OKAY,BAR,BRUGNUM,EXDATE,ISSDATE,TNODE,DRUGNM,RXNUM,NODE,NM,SS,ZZ,XX,BAT,PHAR,SITE,ST,TDTM,LINE,CNT,TOTORD,TOTRX,RECD,SITEN,X,BEG,END,PSOION,PSLION,ZX
- K ZTSAVE("BAT"),ZTSAVE("PSLION"),ZTDESC,ZTIO,ZTRTN,ZTSK,FILL,I,NAME,ORDNUM,PTR,REC,REC1,RELD,RXN,SSN,TMP,XXT,%ZIS,DIROUT,DIRUT,DTOUT,DUOUT,STOP
- D ^%ZISC I $D(IO("Q")) K IO("Q")
- Q
- SUB W @IOF S CNT=0
- W !,?25,"Data Transmission # ",BAT,!
- W !,"Facility : ",SITE,?40,"Division: ",PHAR
- W !,"Received on ",$P(TDTM,":",1,2),?40,"Total Orders: ",TOTORD,?60,"Total Rx's: ",TOTRX,!
- SUB1 W !,"NAME",?22,"SSN",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"
- W ! S LINE="-" F I=0:1:79 W LINE
- W ! S CNT=CNT+6
- Q
- LIST W !,$E(NAME,1,20),?22,$P(SSN,"-",3),?28,RXNUM,?39,BAR,?54,$E(DRUGNM,1,25)
- S CNT=CNT+1
- I $G(IOST)["C-" D
- .I CNT>20 S DIR(0)="E",DIR("A")="Press RETURN to continue " D ^DIR S:$G(Y)'>0 STOP=1 Q:$G(STOP) D SUB
- .K DIRUT,DIROUT,DTOUT,DUOUT
- I $G(IOST)'["C-" D
- .I CNT>56 D SUB
- K DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,OKAY,NEXT,NEXT2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXLIST 3461 printed Feb 18, 2025@23:10:49 Page 2
- PSXLIST ;BIR/WPB-Report Routine to List Orders/Rx's in a Batch ;04/08/97 2:06 PM
- +1 ;;2.0;CMOP;**38**;11 Apr 97
- EN1 ;prints order/rx data from 512 at host
- +1 SET DIC="^PSX(552.1,"
- SET DIC("S")="I ($P($G(^PSX(552.1,+Y,0)),U,4)'=""""),($D(^PSX(552.1,""AQ"",$P($G(^PSX(552.1,+Y,0)),U,4),$P($G(^PSX(552.1,+Y,0)),U,1),+Y)))"
- SET DIC(0)="AEQMZ"
- DO ^DIC
- KILL DIC
- if Y'>0!($DATA(DTOUT))
- QUIT
- SET BAT=$PIECE(Y,"^",2)
- +2 KILL Y
- END SET %ZIS="Q"
- SET %ZIS("B")=""
- DO ^%ZIS
- SET PSLION=ION
- IF POP
- WRITE !,"No Device Selected"
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- DO QUE
- GOTO EX1
- +2 DO P512
- if $GET(STOP)
- GOTO EX1
- GOTO EXIT
- +3 QUIT
- QUE SET ZTRTN="P512^PSXLIST"
- SET ZTDESC="CMOP Data Transmission Report"
- SET ZTSAVE("BAT")=""
- SET ZTSAVE("PSLION")=""
- SET ZTIO=PSLION
- DO ^%ZTLOAD
- +1 IF $DATA(ZTSK)[0
- WRITE !!,"Job Canceled"
- +2 IF '$TEST
- WRITE !!,"Job Queued"
- +3 DO HOME^%ZIS
- +4 QUIT
- +5 ;Called by Taskman to list Rx's/orders in a batch
- P512 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 USE IO
- +2 SET RECD=$ORDER(^PSX(552.1,"B",BAT,""))
- SET SITEN=$PIECE(BAT,"-",1)
- +3 ;N X,Y S DIC=4,DIC(0)="MNZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=$S($G(Y)]"":$P(Y,"^",2),1:"UNKNOWN") ;****DOD L1
- +4 ;****DOD L1
- NEW X,Y
- SET X=SITEN
- SET AGNCY="VASTANUM"
- if $DATA(^PSX(552,"D",X))
- SET X=$EXTRACT(X,2,99)
- SET AGNCY="DMIS"
- SET SITE=$$IEN^XUMF(4,AGNCY,X)
- SET SITE=$SELECT($GET(SITE)]"":$$NAME^XUAF4(SITE),1:"UNKNOWN")
- +5 SET PHAR=$PIECE(^PSX(552.1,RECD,"P"),U,1)
- SET X=$PIECE(^PSX(552.1,RECD,0),U,4)
- SET TDTM=$$FMTE^XLFDT(X,"1P")
- +6 SET TOTRX=$PIECE($GET(^PSX(552.1,RECD,1)),U,4)
- SET TOTORD=$PIECE($GET(^PSX(552.1,RECD,1)),U,3)
- +7 DO SUB
- +8 SET OKAY=0
- SET XX=0
- FOR
- SET XX=$ORDER(^PSX(552.2,"AQ",BAT,XX))
- if XX'>0
- QUIT
- if $GET(STOP)
- QUIT
- SET ORDNUM=XX
- SET ZZ=0
- FOR
- SET ZZ=$ORDER(^PSX(552.2,XX,"T",ZZ))
- if ZZ'>0
- QUIT
- SET NODE=$GET(^PSX(552.2,XX,"T",ZZ,0))
- Begin DoDot:1
- +9 if $GET(STOP)
- QUIT
- +10 if $EXTRACT(NODE,1,4)["MSH|"!($EXTRACT(NODE,1,4)["NTE|")
- QUIT
- +11 IF $EXTRACT(NODE,1,4)["PID|"
- SET NM=$PIECE(NODE,"|",6)
- SET SS=$PIECE($PIECE(NODE,"|",4),"^",1)
- SET SSN=$EXTRACT(SS,1,3)_"-"_$EXTRACT(SS,4,5)_"-"_$EXTRACT(SS,6,9)
- SET NAME=$PIECE(NM,"^",1)_", "_$PIECE(NM,"^",2)
- +12 IF $EXTRACT(NODE,1,4)["ORC|"
- SET ZX=ZZ
- FOR
- SET ZX=$ORDER(^PSX(552.2,XX,"T",ZX))
- if ZX'>0
- QUIT
- SET TNODE=$GET(^PSX(552.2,XX,"T",ZX,0))
- Begin DoDot:2
- +13 if $GET(STOP)
- QUIT
- +14 if $EXTRACT(TNODE,1,4)["NTE|"
- QUIT
- +15 IF $EXTRACT(TNODE,1,4)["ORC|"
- SET ZZ=ZX
- QUIT
- +16 IF $EXTRACT(TNODE,1,4)["RX1|"
- SET DRUGNUM=$PIECE($PIECE(TNODE,"|",15),"^",1)
- SET DRUGNM=$PIECE($PIECE(TNODE,"|",15),"^",2)
- SET ISSDATE=$PIECE(TNODE,"|",21)
- SET EXDATE=$PIECE(TNODE,"|",25)
- SET RXNUM=$PIECE(TNODE,"|",27)
- SET IDATE=$EXTRACT(ISSDATE,5,6)_"/"_$EXTRACT(ISSDATE,7,8)_"/"_$EXTRACT(ISSDATE,3,4)
- Begin DoDot:3
- +17 SET EDATE=$EXTRACT(EXDATE,5,6)_"/"_$EXTRACT(EXDATE,7,8)_"/"_$EXTRACT(EXDATE,3,4)
- End DoDot:3
- QUIT
- +18 IF $EXTRACT(TNODE,1,4)["ZX1|"
- SET OKAY=1
- SET BAR=$PIECE(TNODE,"|",16)
- DO LIST
- QUIT
- End DoDot:2
- End DoDot:1
- +19 QUIT
- EXIT IF $GET(IOST)["C-"
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue "
- DO ^DIR
- KILL DIR
- WRITE @IOF
- EX1 KILL IDATE,EDATE,OKAY,BAR,BRUGNUM,EXDATE,ISSDATE,TNODE,DRUGNM,RXNUM,NODE,NM,SS,ZZ,XX,BAT,PHAR,SITE,ST,TDTM,LINE,CNT,TOTORD,TOTRX,RECD,SITEN,X,BEG,END,PSOION,PSLION,ZX
- +1 KILL ZTSAVE("BAT"),ZTSAVE("PSLION"),ZTDESC,ZTIO,ZTRTN,ZTSK,FILL,I,NAME,ORDNUM,PTR,REC,REC1,RELD,RXN,SSN,TMP,XXT,%ZIS,DIROUT,DIRUT,DTOUT,DUOUT,STOP
- +2 DO ^%ZISC
- IF $DATA(IO("Q"))
- KILL IO("Q")
- +3 QUIT
- SUB WRITE @IOF
- SET CNT=0
- +1 WRITE !,?25,"Data Transmission # ",BAT,!
- +2 WRITE !,"Facility : ",SITE,?40,"Division: ",PHAR
- +3 WRITE !,"Received on ",$PIECE(TDTM,":",1,2),?40,"Total Orders: ",TOTORD,?60,"Total Rx's: ",TOTRX,!
- SUB1 WRITE !,"NAME",?22,"SSN",?28,"RX NUMBER",?39,"BAR CODE",?54,"DRUG NAME"
- +1 WRITE !
- SET LINE="-"
- FOR I=0:1:79
- WRITE LINE
- +2 WRITE !
- SET CNT=CNT+6
- +3 QUIT
- LIST WRITE !,$EXTRACT(NAME,1,20),?22,$PIECE(SSN,"-",3),?28,RXNUM,?39,BAR,?54,$EXTRACT(DRUGNM,1,25)
- +1 SET CNT=CNT+1
- +2 IF $GET(IOST)["C-"
- Begin DoDot:1
- +3 IF CNT>20
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue "
- DO ^DIR
- if $GET(Y)'>0
- SET STOP=1
- if $GET(STOP)
- QUIT
- DO SUB
- +4 KILL DIRUT,DIROUT,DTOUT,DUOUT
- End DoDot:1
- +5 IF $GET(IOST)'["C-"
- Begin DoDot:1
- +6 IF CNT>56
- DO SUB
- End DoDot:1
- +7 KILL DRUGNUM,DRUGNM,RXNUM,ISSDATE,EXDATE,BAR,OKAY,NEXT,NEXT2
- +8 QUIT