- PSOLLLHN ;BIR/SJA - HIPAA/NCPDP LASER LABELS ;2/21/07 10:21am
- ;;7.0;OUTPATIENT PHARMACY;**200,268,326,350**;DEC 1997;Build 4
- ;
- ;*244 ignore Rx status > 11
- ;
- ST ; ENTRY POINT TO SPEED SIGNATURE LOG REPRINT
- I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) Q
- N REPRINT,PS,STATE,PS2,PSOHZIP,PSODISP,PSOOELSE,PSOIEN,VALMCNT
- S PS=$S($D(^PS(59,PSOSITE,0)):^(0),1:"")
- S PS2=$P(PS,"^")_"^"_$P(PS,"^",6)
- I $P(PSOSYS,"^",4),$D(^PS(59,+$P($G(PSOSYS),"^",4),0)) S PS=^PS(59,$P($G(PSOSYS),"^",4),0)
- S VAADDR1=$P(PS,"^"),VASTREET=$P(PS,"^",2),STATE=$S($D(^DIC(5,+$P(PS,"^",8),0)):$P(^(0),"^",2),1:"UNKNOWN")
- S PSZIP=$P(PS,"^",5),PSOHZIP=$S(PSZIP["-":PSZIP,1:$E(PSZIP,1,5)_$S($E(PSZIP,6,9)]"":"-"_$E(PSZIP,6,9),1:""))
- D 6^VADPT,PID^VADPT6 S SSNP=""
- S REPRINT=1
- I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
- OS K DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR S LST=Y I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
- K DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX I '+LST D KILL S VALMBCK="" Q
- S PSOOELSE=1 D FULL^VALM1
- Q1 K POP,ZTSK S %ZIS("B")="",%ZIS="MNQ",%ZIS("A")="Select LABEL DEVICE: " D ^%ZIS S PSLION=ION K %ZIS("A")
- I $G(POP) S VALMBCK="R",VALMSG="No Labels Reprinted." Q
- I $G(IOST(0)),'$D(^%ZIS(2,IOST(0),55,"B","LL")) W !,"Must specify a laser labels printer for Signature Log Reprint" G Q1
- I '$G(IOST(0)) S VALMBCK="R",VALMSG="Nothing queued to print." Q
- D DEM^VADPT S PNM=VADM(1)
- I $P(VADM(6),"^",2)]"" D G OS
- .W $C(7),!!,PNM_" Died "_$P(VADM(6),"^",2)_".",!
- S PPL="" F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']"" S ORN=$P(LST,",",ORD),PSOIEN=$P(PSOLST(ORN),"^",2) D
- .I '$P($G(^PSRX(PSOIEN,0)),"^",2)!($G(^("STA"),"^")>11) Q
- .I $P($G(^PSRX(PSOIEN,0)),"^",2) S PPL=$S(PPL:PPL_",",1:"")_PSOIEN
- .S VALMBCK="R"
- I +PPL D QUEUE W:$D(ZTSK) !!,"Signature Log Reprint queued",!! H 1
- I '$G(PSOOELSE) S VALMBCK=""
- D ^PSOBUILD
- D KILL D KVA^VADPT
- Q
- QUEUE D NOW^%DTC S Y=$P(%,"."),PSOFNOW=% X ^DD("DD") S PSONOW=Y
- F G="PPL","REPRINT","PNM","STATE","PS2","PSOHZIP","PSOPAR","PSOSITE","PS","PSONOW","PSOSYS","RX","SSNP","DFN" S:$D(@G) ZTSAVE(G)=""
- S ZTRTN="DQ^PSOLLLH",ZTIO=PSLION,ZTDESC="Outpatient Pharmacy Signature Log Reprint",ZTDTH=$H,PDUZ=DUZ
- D ^%ZISC,^%ZTLOAD K G
- Q
- ;
- KILL ; CLEAN UP VARIABLES
- K DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLLHN 2405 printed Mar 13, 2025@21:35:33 Page 2
- PSOLLLHN ;BIR/SJA - HIPAA/NCPDP LASER LABELS ;2/21/07 10:21am
- +1 ;;7.0;OUTPATIENT PHARMACY;**200,268,326,350**;DEC 1997;Build 4
- +2 ;
- +3 ;*244 ignore Rx status > 11
- +4 ;
- ST ; ENTRY POINT TO SPEED SIGNATURE LOG REPRINT
- +1 IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- QUIT
- +2 NEW REPRINT,PS,STATE,PS2,PSOHZIP,PSODISP,PSOOELSE,PSOIEN,VALMCNT
- +3 SET PS=$SELECT($DATA(^PS(59,PSOSITE,0)):^(0),1:"")
- +4 SET PS2=$PIECE(PS,"^")_"^"_$PIECE(PS,"^",6)
- +5 IF $PIECE(PSOSYS,"^",4)
- IF $DATA(^PS(59,+$PIECE($GET(PSOSYS),"^",4),0))
- SET PS=^PS(59,$PIECE($GET(PSOSYS),"^",4),0)
- +6 SET VAADDR1=$PIECE(PS,"^")
- SET VASTREET=$PIECE(PS,"^",2)
- SET STATE=$SELECT($DATA(^DIC(5,+$PIECE(PS,"^",8),0)):$PIECE(^(0),"^",2),1:"UNKNOWN")
- +7 SET PSZIP=$PIECE(PS,"^",5)
- SET PSOHZIP=$SELECT(PSZIP["-":PSZIP,1:$EXTRACT(PSZIP,1,5)_$SELECT($EXTRACT(PSZIP,6,9)]"":"-"_$EXTRACT(PSZIP,6,9),1:""))
- +8 DO 6^VADPT
- DO PID^VADPT6
- SET SSNP=""
- +9 SET REPRINT=1
- +10 IF '$GET(PSOCNT)
- SET VALMSG="This patient has no Prescriptions!"
- SET VALMBCK=""
- QUIT
- OS KILL DIR,DUOUT,DIRUT
- SET DIR("A")="Select Orders by number"
- SET DIR(0)="LO^1:"_PSOCNT
- DO ^DIR
- SET LST=Y
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DUOUT
- SET VALMBCK=""
- QUIT
- +1 KILL DIR,DIRUT,DTOUT,PSOOELSE,PSOREPX
- IF '+LST
- DO KILL
- SET VALMBCK=""
- QUIT
- +2 SET PSOOELSE=1
- DO FULL^VALM1
- Q1 KILL POP,ZTSK
- SET %ZIS("B")=""
- SET %ZIS="MNQ"
- SET %ZIS("A")="Select LABEL DEVICE: "
- DO ^%ZIS
- SET PSLION=ION
- KILL %ZIS("A")
- +1 IF $GET(POP)
- SET VALMBCK="R"
- SET VALMSG="No Labels Reprinted."
- QUIT
- +2 IF $GET(IOST(0))
- IF '$DATA(^%ZIS(2,IOST(0),55,"B","LL"))
- WRITE !,"Must specify a laser labels printer for Signature Log Reprint"
- GOTO Q1
- +3 IF '$GET(IOST(0))
- SET VALMBCK="R"
- SET VALMSG="Nothing queued to print."
- QUIT
- +4 DO DEM^VADPT
- SET PNM=VADM(1)
- +5 IF $PIECE(VADM(6),"^",2)]""
- Begin DoDot:1
- +6 WRITE $CHAR(7),!!,PNM_" Died "_$PIECE(VADM(6),"^",2)_".",!
- End DoDot:1
- GOTO OS
- +7 SET PPL=""
- FOR ORD=1:1:$LENGTH(LST,",")
- if $PIECE(LST,",",ORD)']""
- QUIT
- SET ORN=$PIECE(LST,",",ORD)
- SET PSOIEN=$PIECE(PSOLST(ORN),"^",2)
- Begin DoDot:1
- +8 IF '$PIECE($GET(^PSRX(PSOIEN,0)),"^",2)!($GET(^("STA"),"^")>11)
- QUIT
- +9 IF $PIECE($GET(^PSRX(PSOIEN,0)),"^",2)
- SET PPL=$SELECT(PPL:PPL_",",1:"")_PSOIEN
- +10 SET VALMBCK="R"
- End DoDot:1
- +11 IF +PPL
- DO QUEUE
- if $DATA(ZTSK)
- WRITE !!,"Signature Log Reprint queued",!!
- HANG 1
- +12 IF '$GET(PSOOELSE)
- SET VALMBCK=""
- +13 DO ^PSOBUILD
- +14 DO KILL
- DO KVA^VADPT
- +15 QUIT
- QUEUE DO NOW^%DTC
- SET Y=$PIECE(%,".")
- SET PSOFNOW=%
- XECUTE ^DD("DD")
- SET PSONOW=Y
- +1 FOR G="PPL","REPRINT","PNM","STATE","PS2","PSOHZIP","PSOPAR","PSOSITE","PS","PSONOW","PSOSYS","RX","SSNP","DFN"
- if $DATA(@G)
- SET ZTSAVE(G)=""
- +2 SET ZTRTN="DQ^PSOLLLH"
- SET ZTIO=PSLION
- SET ZTDESC="Outpatient Pharmacy Signature Log Reprint"
- SET ZTDTH=$HOROLOG
- SET PDUZ=DUZ
- +3 DO ^%ZISC
- DO ^%ZTLOAD
- KILL G
- +4 QUIT
- +5 ;
- KILL ; CLEAN UP VARIABLES
- +1 KILL DIC,LST,ORD,ORN,PSOIEN,PNM,PPL,PSZIP,RX,SSNP,VA,VADDR1,VADM,VAEL,VAPA,VASTREET
- +2 QUIT
