Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSPMV

PSOSPMV.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;RX(PSORXLST) ; Repeating RX prompt for one or more RX #'s
  1. MULTI ; Entry Point
  1. N DIR,DIRUT,X,PSOQUIT,RXIEN,SCREEN,STATEIEN,PSOTTCNT,PSOTPCNT,DFN,VALM,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN,BATIEN
  1. N PSOBATLST,PSODONE,PSOFROM,PSOTO
  1. S PSODONE=0,STATEIEN="",PSOFROM=$$FMADD^XLFDT($$NOW^XLFDT,,,,-1)
  1. F Q:$G(PSODONE) D RXLOOP(.PSODONE)
  1. Q:'$O(PSOBATLST(0))
  1. S PSOTXRTS=1 ;+$$GET1^DIQ(58.41,STATEIEN,12,"I")
  1. S PSOTO=$$FMADD^XLFDT($$NOW^XLFDT,,,,1)
  1. ;
  1. S STATEIEN=0 F S STATEIEN=$O(PSOBATLST(STATEIEN)) Q:'STATEIEN D EN(STATEIEN,PSOFROM,PSOTO)
  1. Q
  1. ;
  1. EN(STATE,PSOFROM,PSOTO) ; Entry point
  1. N STATEIEN S STATEIEN=STATE
  1. D EN^VALM("PSO SPMP BATCH PROCESSING")
  1. D FULL^VALM1
  1. Q
  1. ;
  1. RXLOOP(PSODONE) ; - Prompt for Rx, Fill, Record Type
  1. N SCREEN,RXIEN,FILLNUM,RECTYPE,RXERMSG,STATELST,LST,MBMST,DFN
  1. K DIR S DIR(0)="FAO^1:30",DIR("A")=" PRESCRIPTION: ",(DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
  1. D ^DIR I X=""!$D(DIRUT) S PSODONE=1 Q
  1. S X=$$UP^XLFSTR(X),PSOQUIT=0
  1. I $E(X,1,2)'="E." S RXIEN=+$$RXLKP(X) I RXIEN<0 D Q
  1. .W !?5,"Invalid Prescription Number"
  1. I $E(X,1,2)="E." D I PSOQUIT Q
  1. . I $L(X)'=9 W !?5,"The ECME# must be 7 digits long!",$C(7) S PSOQUIT=1 Q
  1. . S RXIEN=+$$RXNUM^PSOBPSU2($E(X,3,9)) I RXIEN<0 W " ??" S PSOQUIT=1 Q
  1. ; Get State IEN, Notify and Quit if no state or problems with PMP params
  1. D ONEFILL(RXIEN,.FILLNUM) I $D(DUOUT)!($D(DIRUT))!(FILLNUM="^") K DIRUT,DUOUT,DIR W ! Q
  1. S SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
  1. I +SCREEN D Q:$P(SCREEN,"^",3)="E"
  1. . W !!?1,$S($P(SCREEN,"^",3)="E":"ERROR",1:"WARNING"),": ",$P(SCREEN,"^",2),$C(7) D PAUSE^PSOSPMU1
  1. D RECTYP(RXIEN,FILLNUM,.RECTYPE) I $G(DUOUT)!$G(DTOUT) K DUOUT,DTOUT Q
  1. ;
  1. S STATE=$$RXSTATE^PSOBPSUT(RXIEN,0) ;P662
  1. S STATELST=$$RXSTATEP^PSOBPSUT(RXIEN,0,STATE)
  1. S DFN=$$GET1^DIQ(52,RXIEN,2,"I") D ADD^VADPT I +VAPA(5)]"" D
  1. . S MBMST=$$GET1^DIQ(58.41,+VAPA(5),21,"I")
  1. . I (+MBMST=2),(STATELST'[("^"_+VAPA(5)_"^")) S STATELST=STATELST_+VAPA(5)_"^"
  1. . I (+MBMST=2),(RECTYPE="V") S STATELST=$$VOIDST(RXIEN,FILLNUM) ;P696
  1. F LST=1:1:$L(STATELST,"^") D
  1. . S STATEIEN=$P(STATELST,"^",LST) Q:STATEIEN=""
  1. . S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I")
  1. . S PSOTXRTS=+$$GET1^DIQ(58.41,STATEIEN,12,"I")
  1. . I 'STATEIEN D Q
  1. . . S RXERMSG="No State on file for Division "_$$GET1^DIQ(59,$$RXSITE^PSOBPSUT(RXIEN,0),.01)
  1. . . W !?5,RXERMSG
  1. . S RXERMSG=$$SPOK^PSOSPMUT(STATEIEN)
  1. . I '(RXERMSG>0) W !?5,$P(RXERMSG,"^",2) Q
  1. . ;
  1. . D GETDATA(RXIEN,FILLNUM,RECTYPE,.PSORXOK)
  1. . S BATIEN=$$BLDBAT("RX",.PSOBATLST)
  1. . Q
  1. Q
  1. ;
  1. ONEFILL(RXIEN,FILLNUM) ; Get All Fills for on RX#
  1. S FILLNUM=$$RXFILL^PSOSPMU2(RXIEN) I FILLNUM="^" Q
  1. ;
  1. ; The legislation allowing VA to report was published on 02/11/2013
  1. I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),$$RXRLDT^PSOBPSUT(RXIEN,FILLNUM)<3130211 D Q
  1. . W !!?1,"Only prescription fills dispensed on or after Feb 11, 2013 can be exported.",$C(7)
  1. . S FILLNUM="^"
  1. Q
  1. ;
  1. RECTYP(RXIEN,FILLNUM,RECTYPE) ; Get Record Type
  1. S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I") S:PSOASVER="" PSOASVER="4.2"
  1. ;
  1. K DIR S DIR("A")="Record Type"
  1. S DIR("L",1)="Enter the type of record to be sent for this prescription fill:"
  1. S DIR("L",2)=" "
  1. S DIR("??")="^D ASAPHELP^PSOSPMU2(PSOASVER,""DSP"",1)"
  1. I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) D
  1. . S DIR(0)="S^N:NEW;R:REVISE;V:VOID"
  1. . S DIR("L",3)=" N NEW"
  1. . S DIR("L",4)=" R REVISE"
  1. . S DIR("L")=" V VOID"
  1. . S DIR("B")="NEW"
  1. E D
  1. . S DIR(0)="S^V:VOID"
  1. . S DIR("L")=" V VOID RECORD"
  1. . S DIR("B")="VOID"
  1. D ^DIR I $D(DUOUT)!($D(DIRUT)) W ! Q
  1. ;
  1. S RECTYPE=Y
  1. Q
  1. ;
  1. GETDATA(RXIEN,FILLNUM,RECTYPE,PSORXOK) ; Entry point
  1. N ASAP,SITEIEN,PATIEN,FILLIEN,DRUGIEN,PREIEN,RPHIEN,RSTREC,RTSDATA,PSONAME,TRXTYPE,RTSREC
  1. ;
  1. S:$G(FILLNUM)="" FILLNUM=0
  1. S PSOASVER=$$GET1^DIQ(58.41,STATEIEN,1,"I") S:PSOASVER="" PSOASVER="4.2"
  1. S SITEIEN=$$RXSITE^PSOBPSUT(RXIEN,0)
  1. S (PATIEN,DFN)=$$GET1^DIQ(52,RXIEN,2,"I")
  1. D DEM^VADPT,ADD^VADPT,SETNAME^PSOSPMUT(DFN)
  1. S DRUGIEN=$$GET1^DIQ(52,RXIEN,6,"I")
  1. S FILLIEN=$S(FILLNUM["P":+$P(FILLNUM,"P",2),1:+FILLNUM)
  1. S TRXTYPE="S"
  1. S PREIEN=$$PREIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
  1. S RPHIEN=$$RPHIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
  1. S ^TMP("PSOSPMRX",$J,STATEIEN,RXIEN,FILLNUM)=RECTYPE
  1. Q
  1. ;
  1. 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
  1. ; (r) List of Rx's: ^TMP("PSOSPMRX",$J,STATE,RXIEN,RXFILL)=Record Type ((N)ew/(R)evise/(V)oid)
  1. ; Note: This ^TMP global will be cleaned up at the end
  1. ;Output: BATCHIEN - New Batch IEN (Pointer to #58.42) OR "01^Error Message"
  1. N STATE,SPOK,RX,FILL,BATCHIEN,DRUGIEN,%,DIC,DR,DA,X,Y,XX,DINUM,DLAYGO,DD,DO,NDC,RECTYPE
  1. I '$O(^TMP("PSOSPMRX",$J,0)) Q "-1^No prescription data"
  1. ;
  1. S (STATE,RX)=0,FILL=""
  1. F S STATE=$O(^TMP("PSOSPMRX",$J,STATE)) Q:'STATE D I $P(BATCHIEN,"^")=-1 Q
  1. . S XX=$$SPOK^PSOSPMUT(STATE) I $P(XX,"^",1)=-1 S BATCHIEN=XX Q
  1. . F L +^PS(58.42,0):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) Q:$T H 3
  1. . S (DINUM,BATCHIEN)=$O(^PS(58.42,999999999999),-1)+1
  1. . I EXPTYPE'="VD" W !!,"Creating Batch #",DINUM," for ",$$GET1^DIQ(58.41,STATE,.01),"..."
  1. . S DIC="^PS(58.42,",X=DINUM,DIC(0)="",DIC("DR")="1////"_STATE_";2///"_EXPTYPE_";8///"_$$NOW^XLFDT()_";10////"_DUZ
  1. . I $G(BEGRLDT) D
  1. . . S DIC("DR")=DIC("DR")_";4///"_BEGRLDT_";5///"_$G(ENDRLDT)
  1. . S DLAYGO=58.42 K DD,DO D FILE^DICN K DD,DO
  1. . L -^PS(58.42,0)
  1. . I Y=-1 S BATCHIEN="-1^Export Batch could not be created" Q
  1. . F S RX=$O(^TMP("PSOSPMRX",$J,STATE,RX)) Q:'RX D
  1. . . S DRUGIEN=$$GET1^DIQ(52,RX,6,"I")
  1. . . F S FILL=$O(^TMP("PSOSPMRX",$J,STATE,RX,FILL)) Q:FILL="" D
  1. . . . S PSOBATLST(STATE,BATCHIEN)=""
  1. . . . K DIC,DINUM,DA S DIC="^PS(58.42,"_BATCHIEN_",""RX"",",DIC(0)="",DA(1)=BATCHIEN
  1. . . . S RECTYPE=^TMP("PSOSPMRX",$J,STATE,RX,FILL)
  1. . . . I RECTYPE="V" D
  1. . . . . S NDC=$$GETNDC^PSOSPMU1(RX,FILL)
  1. . . . E D
  1. . . . . I $L($$NUMERIC^PSOASAP0($$GET1^DIQ(50,DRUGIEN,31)))=11 D
  1. . . . . . S NDC=$$GET1^DIQ(50,DRUGIEN,31)
  1. . . . . E S NDC=$$GETNDC^PSONDCUT(RX,+FILL)
  1. . . . S X=RX,DIC("DR")="1///"_FILL_";2///"_RECTYPE_";3///"_NDC
  1. . . . S DLAYGO=58.42001 K DD,DO D FILE^DICN K DD,DO
  1. . I EXPTYPE'="VD" W "Done."
  1. K ^TMP("PSOSPMRX",$J)
  1. Q BATCHIEN
  1. ;
  1. RXLKP(RXNUM) ; - Peforms Lookup on the PRESCRIPTION file
  1. N DIC,X,Y,D
  1. S DIC="^PSRX(",DIC(0)="QE",D="B",X=RXNUM
  1. D IX^DIC
  1. Q Y
  1. ;
  1. VDRXBAT(BATIEN) ; Check for VOIDs in RX batch
  1. N EXPTYP,RECTYP,REC,RECTYPAR
  1. S VDRXBAT=0
  1. S EXPTYP=$$GET1^DIQ(58.42,BATIEN,2,"I") Q:'(EXPTYP="RX") VDRXBAT
  1. D LIST^DIC(58.42001,","_BATIEN_",","@;2I",,,,,,,,"RECTYPAR")
  1. 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
  1. Q VDRXBAT
  1. ;
  1. 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
  1. N BAT,STATECK,RXNODE,DONE
  1. S DONE=0
  1. S BAT=999999999999 F S BAT=$O(^PS(58.42,"ARX",RXIEN,FILL,BAT),-1) Q:(BAT="")!(DONE=1) D
  1. . S RXNODE=0 F S RXNODE=$O(^PS(58.42,"ARX",RXIEN,FILL,BAT,RXNODE)) Q:(RXNODE="")!(DONE=1) D
  1. . . Q:$P(^PS(58.42,BAT,"RX",RXNODE,0),"^",3)="V"
  1. . . S STATECK=$$GET1^DIQ(58.42,BAT,1,"I") S DONE=1
  1. Q STATECK