PSOSPMV ;BIRM/MFR - Multiple Individual Prescription ASAP Data Listman Driver ;09/29/2020
;;7.0;OUTPATIENT PHARMACY;**625,662,696**;DEC 1997;Build 4
;
;
;RX(PSORXLST) ; Repeating RX prompt for one or more RX #'s
MULTI ; Entry Point
N DIR,DIRUT,X,PSOQUIT,RXIEN,SCREEN,STATEIEN,PSOTTCNT,PSOTPCNT,DFN,VALM,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN,BATIEN
N PSOBATLST,PSODONE,PSOFROM,PSOTO
S PSODONE=0,STATEIEN="",PSOFROM=$$FMADD^XLFDT($$NOW^XLFDT,,,,-1)
F Q:$G(PSODONE) D RXLOOP(.PSODONE)
Q:'$O(PSOBATLST(0))
S PSOTXRTS=1 ;+$$GET1^DIQ(58.41,STATEIEN,12,"I")
S PSOTO=$$FMADD^XLFDT($$NOW^XLFDT,,,,1)
;
S STATEIEN=0 F S STATEIEN=$O(PSOBATLST(STATEIEN)) Q:'STATEIEN D EN(STATEIEN,PSOFROM,PSOTO)
Q
;
EN(STATE,PSOFROM,PSOTO) ; Entry point
N STATEIEN S STATEIEN=STATE
D EN^VALM("PSO SPMP BATCH PROCESSING")
D FULL^VALM1
Q
;
RXLOOP(PSODONE) ; - Prompt for Rx, Fill, Record Type
N SCREEN,RXIEN,FILLNUM,RECTYPE,RXERMSG,STATELST,LST,MBMST,DFN
K DIR S DIR(0)="FAO^1:30",DIR("A")=" PRESCRIPTION: ",(DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
D ^DIR I X=""!$D(DIRUT) S PSODONE=1 Q
S X=$$UP^XLFSTR(X),PSOQUIT=0
I $E(X,1,2)'="E." S RXIEN=+$$RXLKP(X) I RXIEN<0 D Q
.W !?5,"Invalid Prescription Number"
I $E(X,1,2)="E." D I PSOQUIT Q
. I $L(X)'=9 W !?5,"The ECME# must be 7 digits long!",$C(7) S PSOQUIT=1 Q
. S RXIEN=+$$RXNUM^PSOBPSU2($E(X,3,9)) I RXIEN<0 W " ??" S PSOQUIT=1 Q
; Get State IEN, Notify and Quit if no state or problems with PMP params
D ONEFILL(RXIEN,.FILLNUM) I $D(DUOUT)!($D(DIRUT))!(FILLNUM="^") K DIRUT,DUOUT,DIR W ! Q
S SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
I +SCREEN D Q:$P(SCREEN,"^",3)="E"
. W !!?1,$S($P(SCREEN,"^",3)="E":"ERROR",1:"WARNING"),": ",$P(SCREEN,"^",2),$C(7) D PAUSE^PSOSPMU1
D RECTYP(RXIEN,FILLNUM,.RECTYPE) I $G(DUOUT)!$G(DTOUT) K DUOUT,DTOUT Q
;
S STATE=$$RXSTATE^PSOBPSUT(RXIEN,0) ;P662
S STATELST=$$RXSTATEP^PSOBPSUT(RXIEN,0,STATE)
S DFN=$$GET1^DIQ(52,RXIEN,2,"I") D ADD^VADPT I +VAPA(5)]"" D
. S MBMST=$$GET1^DIQ(58.41,+VAPA(5),21,"I")
. I (+MBMST=2),(STATELST'[("^"_+VAPA(5)_"^")) S STATELST=STATELST_+VAPA(5)_"^"
. I (+MBMST=2),(RECTYPE="V") S STATELST=$$VOIDST(RXIEN,FILLNUM) ;P696
F LST=1:1:$L(STATELST,"^") D
. S STATEIEN=$P(STATELST,"^",LST) Q:STATEIEN=""
. S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
. S PSOTXRTS=+$$GET1^DIQ(58.41,STATEIEN,12,"I")
. I 'STATEIEN D Q
. . S RXERMSG="No State on file for Division "_$$GET1^DIQ(59,$$RXSITE^PSOBPSUT(RXIEN,0),.01)
. . W !?5,RXERMSG
. S RXERMSG=$$SPOK^PSOSPMUT(STATEIEN)
. I '(RXERMSG>0) W !?5,$P(RXERMSG,"^",2) Q
. ;
. D GETDATA(RXIEN,FILLNUM,RECTYPE,.PSORXOK)
. S BATIEN=$$BLDBAT("RX",.PSOBATLST)
. Q
Q
;
ONEFILL(RXIEN,FILLNUM) ; Get All Fills for on RX#
S FILLNUM=$$RXFILL^PSOSPMU2(RXIEN) I FILLNUM="^" Q
;
; The legislation allowing VA to report was published on 02/11/2013
I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211 D Q
. W !!?1,"Only prescription fills dispensed on or after Feb 11, 2013 can be exported.",$C(7)
. S FILLNUM="^"
Q
;
RECTYP(RXIEN,FILLNUM,RECTYPE) ; Get Record Type
S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I") S:PSOASVER="" PSOASVER="4.2"
;
K DIR S DIR("A")="Record Type"
S DIR("L",1)="Enter the type of record to be sent for this prescription fill:"
S DIR("L",2)=" "
S DIR("??")="^D ASAPHELP^PSOSPMU2(PSOASVER,""DSP"",1)"
I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) D
. S DIR(0)="S^N:NEW;R:REVISE;V:VOID"
. S DIR("L",3)=" N NEW"
. S DIR("L",4)=" R REVISE"
. S DIR("L")=" V VOID"
. S DIR("B")="NEW"
E D
. S DIR(0)="S^V:VOID"
. S DIR("L")=" V VOID RECORD"
. S DIR("B")="VOID"
D ^DIR I $D(DUOUT)!($D(DIRUT)) W ! Q
;
S RECTYPE=Y
Q
;
GETDATA(RXIEN,FILLNUM,RECTYPE,PSORXOK) ; Entry point
N ASAP,SITEIEN,PATIEN,FILLIEN,DRUGIEN,PREIEN,RPHIEN,RSTREC,RTSDATA,PSONAME,TRXTYPE,RTSREC
;
S:$G(FILLNUM)="" FILLNUM=0
S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I") S:PSOASVER="" PSOASVER="4.2"
S SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
S (PATIEN,DFN)=$$GET1^DIQ(52,RXIEN,2,"I")
D DEM^VADPT,ADD^VADPT,SETNAME^PSOSPMUT(DFN)
S DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
S FILLIEN=$S(FILLNUM["P":+$P(FILLNUM,"P",2),1:+FILLNUM)
S TRXTYPE="S"
S PREIEN=$$PREIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
S RPHIEN=$$RPHIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
S ^TMP("PSOSPMRX",$J,STATEIEN,RXIEN,FILLNUM)=RECTYPE
Q
;
BLDBAT(EXPTYPE,PSOBATLST) ; Given a list of Rx's builds a new Export Batch
; Input: (r) EXPTYPE - Export Type ((MA)naul/(SC)heduled/(RX) Single Rx)/(VD) Void Only
; (r) List of Rx's: ^TMP("PSOSPMRX",$J,STATE,RXIEN,RXFILL)=Record Type ((N)ew/(R)evise/(V)oid)
; Note: This ^TMP global will be cleaned up at the end
;Output: BATCHIEN - New Batch IEN (Pointer to #58.42) OR "01^Error Message"
N STATE,SPOK,RX,FILL,BATCHIEN,DRUGIEN,%,DIC,DR,DA,X,Y,XX,DINUM,DLAYGO,DD,DO,NDC,RECTYPE
I '$O(^TMP("PSOSPMRX",$J,0)) Q "-1^No prescription data"
;
S (STATE,RX)=0,FILL=""
F S STATE=$O(^TMP("PSOSPMRX",$J,STATE)) Q:'STATE D I $P(BATCHIEN,"^")=-1 Q
. S XX=$$SPOK^PSOSPMUT(STATE) I $P(XX,"^",1)=-1 S BATCHIEN=XX Q
. F L +^PS(58.42,0):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) Q:$T H 3
. S (DINUM,BATCHIEN)=$O(^PS(58.42,999999999999),-1)+1
. I EXPTYPE'="VD" W !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
. S DIC="^PS(58.42,",X=DINUM,DIC(0)="",DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()_";10////"_DUZ
. I $G(BEGRLDT) D
. . S DIC("DR")=DIC("DR")_";4///"_BEGRLDT_";5///"_$G(ENDRLDT)
. S DLAYGO=58.42 K DD,DO D FILE^DICN K DD,DO
. L -^PS(58.42,0)
. I Y=-1 S BATCHIEN="-1^Export Batch could not be created" Q
. F S RX=$O(^TMP("PSOSPMRX",$J,STATE,RX)) Q:'RX D
. . S DRUGIEN=$$GET1^DIQ(52,RX,6,"I")
. . F S FILL=$O(^TMP("PSOSPMRX",$J,STATE,RX,FILL)) Q:FILL="" D
. . . S PSOBATLST(STATE,BATCHIEN)=""
. . . K DIC,DINUM,DA S DIC="^PS(58.42,"_BATCHIEN_",""RX"",",DIC(0)="",DA(1)=BATCHIEN
. . . S RECTYPE=^TMP("PSOSPMRX",$J,STATE,RX,FILL)
. . . I RECTYPE="V" D
. . . . S NDC=$$GETNDC^PSOSPMU1(RX,FILL)
. . . E D
. . . . I $L($$NUMERIC^PSOASAP0($$GET1^DIQ(50,DRUGIEN,31)))=11 D
. . . . . S NDC=$$GET1^DIQ(50,DRUGIEN,31)
. . . . E S NDC=$$GETNDC^PSONDCUT(RX,+FILL)
. . . S X=RX,DIC("DR")="1///"_FILL_";2///"_RECTYPE_";3///"_NDC
. . . S DLAYGO=58.42001 K DD,DO D FILE^DICN K DD,DO
. I EXPTYPE'="VD" W "Done."
K ^TMP("PSOSPMRX",$J)
Q BATCHIEN
;
RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
N DIC,X,Y,D
S DIC="^PSRX(",DIC(0)="QE",D="B",X=RXNUM
D IX^DIC
Q Y
;
VDRXBAT(BATIEN) ; Check for VOIDs in RX batch
N EXPTYP,RECTYP,REC,RECTYPAR
S VDRXBAT=0
S EXPTYP=$$GET1^DIQ(58.42,BATIEN,2,"I") Q:'(EXPTYP="RX") VDRXBAT
D LIST^DIC(58.42001,","_BATIEN_",","@;2I",,,,,,,,"RECTYPAR")
S REC=0 F Q:VDRXBAT S REC=$O(RECTYPAR("DILIST","ID",REC)) Q:'REC!$G(VDRXBAT) I RECTYPAR("DILIST","ID",REC,2)="V" S VDRXBAT=1
Q VDRXBAT
;
VOIDST(RXIEN,FILL) ; Determine the state to send the void
; Make sure the void is sent to the state that received the most recent fill
N BAT,STATECK,RXNODE,DONE
S DONE=0
S BAT=999999999999 F S BAT=$O(^PS(58.42,"ARX",RXIEN,FILL,BAT),-1) Q:(BAT="")!(DONE=1) D
. S RXNODE=0 F S RXNODE=$O(^PS(58.42,"ARX",RXIEN,FILL,BAT,RXNODE)) Q:(RXNODE="")!(DONE=1) D
. . Q:$P(^PS(58.42,BAT,"RX",RXNODE,0),"^",3)="V"
. . S STATECK=$$GET1^DIQ(58.42,BAT,1,"I") S DONE=1
Q STATECK
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOSPMV 7489 printed Apr 09, 2024@21:34:18 Page 2
PSOSPMV ;BIRM/MFR - Multiple Individual Prescription ASAP Data Listman Driver ;09/29/2020
+1 ;;7.0;OUTPATIENT PHARMACY;**625,662,696**;DEC 1997;Build 4
+2 ;
+3 ;
+4 ;RX(PSORXLST) ; Repeating RX prompt for one or more RX #'s
MULTI ; Entry Point
+1 NEW DIR,DIRUT,X,PSOQUIT,RXIEN,SCREEN,STATEIEN,PSOTTCNT,PSOTPCNT,DFN,VALM,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN,BATIEN
+2 NEW PSOBATLST,PSODONE,PSOFROM,PSOTO
+3 SET PSODONE=0
SET STATEIEN=""
SET PSOFROM=$$FMADD^XLFDT($$NOW^XLFDT,,,,-1)
+4 FOR
if $GET(PSODONE)
QUIT
DO RXLOOP(.PSODONE)
+5 if '$ORDER(PSOBATLST(0))
QUIT
+6 ;+$$GET1^DIQ(58.41,STATEIEN,12,"I")
SET PSOTXRTS=1
+7 SET PSOTO=$$FMADD^XLFDT($$NOW^XLFDT,,,,1)
+8 ;
+9 SET STATEIEN=0
FOR
SET STATEIEN=$ORDER(PSOBATLST(STATEIEN))
if 'STATEIEN
QUIT
DO EN(STATEIEN,PSOFROM,PSOTO)
+10 QUIT
+11 ;
EN(STATE,PSOFROM,PSOTO) ; Entry point
+1 NEW STATEIEN
SET STATEIEN=STATE
+2 DO EN^VALM("PSO SPMP BATCH PROCESSING")
+3 DO FULL^VALM1
+4 QUIT
+5 ;
RXLOOP(PSODONE) ; - Prompt for Rx, Fill, Record Type
+1 NEW SCREEN,RXIEN,FILLNUM,RECTYPE,RXERMSG,STATELST,LST,MBMST,DFN
+2 KILL DIR
SET DIR(0)="FAO^1:30"
SET DIR("A")=" PRESCRIPTION: "
SET (DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
+3 DO ^DIR
IF X=""!$DATA(DIRUT)
SET PSODONE=1
QUIT
+4 SET X=$$UP^XLFSTR(X)
SET PSOQUIT=0
+5 IF $EXTRACT(X,1,2)'="E."
SET RXIEN=+$$RXLKP(X)
IF RXIEN<0
Begin DoDot:1
+6 WRITE !?5,"Invalid Prescription Number"
End DoDot:1
QUIT
+7 IF $EXTRACT(X,1,2)="E."
Begin DoDot:1
+8 IF $LENGTH(X)'=9
WRITE !?5,"The ECME# must be 7 digits long!",$CHAR(7)
SET PSOQUIT=1
QUIT
+9 SET RXIEN=+$$RXNUM^PSOBPSU2($EXTRACT(X,3,9))
IF RXIEN<0
WRITE " ??"
SET PSOQUIT=1
QUIT
End DoDot:1
IF PSOQUIT
QUIT
+10 ; Get State IEN, Notify and Quit if no state or problems with PMP params
+11 DO ONEFILL(RXIEN,.FILLNUM)
IF $DATA(DUOUT)!($DATA(DIRUT))!(FILLNUM="^")
KILL DIRUT,DUOUT,DIR
WRITE !
QUIT
+12 SET SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
+13 IF +SCREEN
Begin DoDot:1
+14 WRITE !!?1,$SELECT($PIECE(SCREEN,"^",3)="E":"ERROR",1:"WARNING"),": ",$PIECE(SCREEN,"^",2),$CHAR(7)
DO PAUSE^PSOSPMU1
End DoDot:1
if $PIECE(SCREEN,"^",3)="E"
QUIT
+15 DO RECTYP(RXIEN,FILLNUM,.RECTYPE)
IF $GET(DUOUT)!$GET(DTOUT)
KILL DUOUT,DTOUT
QUIT
+16 ;
+17 ;P662
SET STATE=$$RXSTATE^PSOBPSUT(RXIEN,0)
+18 SET STATELST=$$RXSTATEP^PSOBPSUT(RXIEN,0,STATE)
+19 SET DFN=$$GET1^DIQ(52,RXIEN,2,"I")
DO ADD^VADPT
IF +VAPA(5)]""
Begin DoDot:1
+20 SET MBMST=$$GET1^DIQ(58.41,+VAPA(5),21,"I")
+21 IF (+MBMST=2)
IF (STATELST'[("^"_+VAPA(5)_"^"))
SET STATELST=STATELST_+VAPA(5)_"^"
+22 ;P696
IF (+MBMST=2)
IF (RECTYPE="V")
SET STATELST=$$VOIDST(RXIEN,FILLNUM)
End DoDot:1
+23 FOR LST=1:1:$LENGTH(STATELST,"^")
Begin DoDot:1
+24 SET STATEIEN=$PIECE(STATELST,"^",LST)
if STATEIEN=""
QUIT
+25 SET PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
+26 SET PSOTXRTS=+$$GET1^DIQ(58.41,STATEIEN,12,"I")
+27 IF 'STATEIEN
Begin DoDot:2
+28 SET RXERMSG="No State on file for Division "_$$GET1^DIQ(59,$$RXSITE^PSOBPSUT(RXIEN,0),.01)
+29 WRITE !?5,RXERMSG
End DoDot:2
QUIT
+30 SET RXERMSG=$$SPOK^PSOSPMUT(STATEIEN)
+31 IF '(RXERMSG>0)
WRITE !?5,$PIECE(RXERMSG,"^",2)
QUIT
+32 ;
+33 DO GETDATA(RXIEN,FILLNUM,RECTYPE,.PSORXOK)
+34 SET BATIEN=$$BLDBAT("RX",.PSOBATLST)
+35 QUIT
End DoDot:1
+36 QUIT
+37 ;
ONEFILL(RXIEN,FILLNUM) ; Get All Fills for on RX#
+1 SET FILLNUM=$$RXFILL^PSOSPMU2(RXIEN)
IF FILLNUM="^"
QUIT
+2 ;
+3 ; The legislation allowing VA to report was published on 02/11/2013
+4 IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)
IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211
Begin DoDot:1
+5 WRITE !!?1,"Only prescription fills dispensed on or after Feb 11, 2013 can be exported.",$CHAR(7)
+6 SET FILLNUM="^"
End DoDot:1
QUIT
+7 QUIT
+8 ;
RECTYP(RXIEN,FILLNUM,RECTYPE) ; Get Record Type
+1 SET PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
if PSOASVER=""
SET PSOASVER="4.2"
+2 ;
+3 KILL DIR
SET DIR("A")="Record Type"
+4 SET DIR("L",1)="Enter the type of record to be sent for this prescription fill:"
+5 SET DIR("L",2)=" "
+6 SET DIR("??")="^D ASAPHELP^PSOSPMU2(PSOASVER,""DSP"",1)"
+7 IF $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)
Begin DoDot:1
+8 SET DIR(0)="S^N:NEW;R:REVISE;V:VOID"
+9 SET DIR("L",3)=" N NEW"
+10 SET DIR("L",4)=" R REVISE"
+11 SET DIR("L")=" V VOID"
+12 SET DIR("B")="NEW"
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 SET DIR(0)="S^V:VOID"
+15 SET DIR("L")=" V VOID RECORD"
+16 SET DIR("B")="VOID"
End DoDot:1
+17 DO ^DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
WRITE !
QUIT
+18 ;
+19 SET RECTYPE=Y
+20 QUIT
+21 ;
GETDATA(RXIEN,FILLNUM,RECTYPE,PSORXOK) ; Entry point
+1 NEW ASAP,SITEIEN,PATIEN,FILLIEN,DRUGIEN,PREIEN,RPHIEN,RSTREC,RTSDATA,PSONAME,TRXTYPE,RTSREC
+2 ;
+3 if $GET(FILLNUM)=""
SET FILLNUM=0
+4 SET PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
if PSOASVER=""
SET PSOASVER="4.2"
+5 SET SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
+6 SET (PATIEN,DFN)=$$GET1^DIQ(52,RXIEN,2,"I")
+7 DO DEM^VADPT
DO ADD^VADPT
DO SETNAME^PSOSPMUT(DFN)
+8 SET DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
+9 SET FILLIEN=$SELECT(FILLNUM["P":+$PIECE(FILLNUM,"P",2),1:+FILLNUM)
+10 SET TRXTYPE="S"
+11 SET PREIEN=$$PREIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
+12 SET RPHIEN=$$RPHIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
+13 SET ^TMP("PSOSPMRX",$JOB,STATEIEN,RXIEN,FILLNUM)=RECTYPE
+14 QUIT
+15 ;
BLDBAT(EXPTYPE,PSOBATLST) ; Given a list of Rx's builds a new Export Batch
+1 ; Input: (r) EXPTYPE - Export Type ((MA)naul/(SC)heduled/(RX) Single Rx)/(VD) Void Only
+2 ; (r) List of Rx's: ^TMP("PSOSPMRX",$J,STATE,RXIEN,RXFILL)=Record Type ((N)ew/(R)evise/(V)oid)
+3 ; Note: This ^TMP global will be cleaned up at the end
+4 ;Output: BATCHIEN - New Batch IEN (Pointer to #58.42) OR "01^Error Message"
+5 NEW STATE,SPOK,RX,FILL,BATCHIEN,DRUGIEN,%,DIC,DR,DA,X,Y,XX,DINUM,DLAYGO,DD,DO,NDC,RECTYPE
+6 IF '$ORDER(^TMP("PSOSPMRX",$JOB,0))
QUIT "-1^No prescription data"
+7 ;
+8 SET (STATE,RX)=0
SET FILL=""
+9 FOR
SET STATE=$ORDER(^TMP("PSOSPMRX",$JOB,STATE))
if 'STATE
QUIT
Begin DoDot:1
+10 SET XX=$$SPOK^PSOSPMUT(STATE)
IF $PIECE(XX,"^",1)=-1
SET BATCHIEN=XX
QUIT
+11 FOR
LOCK +^PS(58.42,0):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
if $TEST
QUIT
HANG 3
+12 SET (DINUM,BATCHIEN)=$ORDER(^PS(58.42,999999999999),-1)+1
+13 IF EXPTYPE'="VD"
WRITE !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
+14 SET DIC="^PS(58.42,"
SET X=DINUM
SET DIC(0)=""
SET DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()_";10////"_DUZ
+15 IF $GET(BEGRLDT)
Begin DoDot:2
+16 SET DIC("DR")=DIC("DR")_";4///"_BEGRLDT_";5///"_$GET(ENDRLDT)
End DoDot:2
+17 SET DLAYGO=58.42
KILL DD,DO
DO FILE^DICN
KILL DD,DO
+18 LOCK -^PS(58.42,0)
+19 IF Y=-1
SET BATCHIEN="-1^Export Batch could not be created"
QUIT
+20 FOR
SET RX=$ORDER(^TMP("PSOSPMRX",$JOB,STATE,RX))
if 'RX
QUIT
Begin DoDot:2
+21 SET DRUGIEN=$$GET1^DIQ(52,RX,6,"I")
+22 FOR
SET FILL=$ORDER(^TMP("PSOSPMRX",$JOB,STATE,RX,FILL))
if FILL=""
QUIT
Begin DoDot:3
+23 SET PSOBATLST(STATE,BATCHIEN)=""
+24 KILL DIC,DINUM,DA
SET DIC="^PS(58.42,"_BATCHIEN_",""RX"","
SET DIC(0)=""
SET DA(1)=BATCHIEN
+25 SET RECTYPE=^TMP("PSOSPMRX",$JOB,STATE,RX,FILL)
+26 IF RECTYPE="V"
Begin DoDot:4
+27 SET NDC=$$GETNDC^PSOSPMU1(RX,FILL)
End DoDot:4
+28 IF '$TEST
Begin DoDot:4
+29 IF $LENGTH($$NUMERIC^PSOASAP0($$GET1^DIQ(50,DRUGIEN,31)))=11
Begin DoDot:5
+30 SET NDC=$$GET1^DIQ(50,DRUGIEN,31)
End DoDot:5
+31 IF '$TEST
SET NDC=$$GETNDC^PSONDCUT(RX,+FILL)
End DoDot:4
+32 SET X=RX
SET DIC("DR")="1///"_FILL_";2///"_RECTYPE_";3///"_NDC
+33 SET DLAYGO=58.42001
KILL DD,DO
DO FILE^DICN
KILL DD,DO
End DoDot:3
End DoDot:2
+34 IF EXPTYPE'="VD"
WRITE "Done."
End DoDot:1
IF $PIECE(BATCHIEN,"^")=-1
QUIT
+35 KILL ^TMP("PSOSPMRX",$JOB)
+36 QUIT BATCHIEN
+37 ;
RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
+1 NEW DIC,X,Y,D
+2 SET DIC="^PSRX("
SET DIC(0)="QE"
SET D="B"
SET X=RXNUM
+3 DO IX^DIC
+4 QUIT Y
+5 ;
VDRXBAT(BATIEN) ; Check for VOIDs in RX batch
+1 NEW EXPTYP,RECTYP,REC,RECTYPAR
+2 SET VDRXBAT=0
+3 SET EXPTYP=$$GET1^DIQ(58.42,BATIEN,2,"I")
if '(EXPTYP="RX")
QUIT VDRXBAT
+4 DO LIST^DIC(58.42001,","_BATIEN_",","@;2I",,,,,,,,"RECTYPAR")
+5 SET REC=0
FOR
if VDRXBAT
QUIT
SET REC=$ORDER(RECTYPAR("DILIST","ID",REC))
if 'REC!$GET(VDRXBAT)
QUIT
IF RECTYPAR("DILIST","ID",REC,2)="V"
SET VDRXBAT=1
+6 QUIT VDRXBAT
+7 ;
VOIDST(RXIEN,FILL) ; Determine the state to send the void
+1 ; Make sure the void is sent to the state that received the most recent fill
+2 NEW BAT,STATECK,RXNODE,DONE
+3 SET DONE=0
+4 SET BAT=999999999999
FOR
SET BAT=$ORDER(^PS(58.42,"ARX",RXIEN,FILL,BAT),-1)
if (BAT="")!(DONE=1)
QUIT
Begin DoDot:1
+5 SET RXNODE=0
FOR
SET RXNODE=$ORDER(^PS(58.42,"ARX",RXIEN,FILL,BAT,RXNODE))
if (RXNODE="")!(DONE=1)
QUIT
Begin DoDot:2
+6 if $PIECE(^PS(58.42,BAT,"RX",RXNODE,0),"^",3)="V"
QUIT
+7 SET STATECK=$$GET1^DIQ(58.42,BAT,1,"I")
SET DONE=1
End DoDot:2
End DoDot:1
+8 QUIT STATECK
