- 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 Feb 19, 2025@00:01:41 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