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.
PSOSPMV ;BIRM/MFR - Multiple Individual Prescription ASAP Data Listman Driver ;09/29/2020
 ;;7.0;OUTPATIENT PHARMACY;**625**;DEC 1997;Build 42
 ;
 ;
 ;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)
 S BATIEN=$$BLDBAT("RX",.PSOBATLST)
 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
 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
 S STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,0)
 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 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 DUTOUT,DTOUT Q
 D GETDATA(RXIEN,FILLNUM,RECTYPE,.PSORXOK)
 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 STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,0)
 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 STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,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