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

PSOSPML4.m

Go to the documentation of this file.
  1. PSOSPML4 ;BIRM/MFR - Single Prescription ASAP Data Listman Driver ;09/01/12
  1. ;;7.0;OUTPATIENT PHARMACY;**408,451,625,659,662**;DEC 1997;Build 4
  1. ;
  1. N DIR,DIRUT,X,PSOQUIT,RXIEN,SCREEN,STATEIEN,PSOTTCNT,PSOTPCNT,DFN,VALM,VALMCNT,VALMHDR,VALMBCK,VALMSG,PSOLSTLN
  1. ;
  1. RX ; - Prescription prompt
  1. K DIR S DIR(0)="FAO^1:30",DIR("A")=" PRESCRIPTION: ",(DIR("?"),DIR("??"))="^D HLP^PSORXVW1"
  1. W ! D ^DIR I X=""!$D(DIRUT) G EXIT
  1. S X=$$UP^XLFSTR(X),PSOQUIT=0
  1. I $E(X,1,2)'="E." S RXIEN=+$$RXLKP(X) I RXIEN<0 G RX
  1. I $E(X,1,2)="E." D I PSOQUIT G RX
  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
  1. ;
  1. S FILLNUM=$$RXFILL^PSOSPMU2(RXIEN) I FILLNUM="^" G EXIT
  1. ;
  1. S SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
  1. I +SCREEN D G RX:$P(SCREEN,"^",3)="E"
  1. . W !!?1,$S($P(SCREEN,"^",3)="E":"ERROR",1:"WARNING"),": ",$P(SCREEN,"^",2),$C(7) D PAUSE^PSOSPMU1
  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 G RX
  1. . W !!?1,"Only prescription fills dispensed on or after Feb 11, 2013 can be exported.",$C(7)
  1. ;
  1. D EN(RXIEN,FILLNUM,"N")
  1. ;
  1. G RX
  1. ;
  1. EN(RXIEN,FILLNUM,RECTYPE) ; Entry point
  1. N ASAP,SITEIEN,PATIEN,FILLIEN,DRUGIEN,PREIEN,RPHIEN,RSTREC,RTSDATA,PSONAME,TRXTYPE,RTSREC
  1. N BATCHIEN
  1. S BATCHIEN=""
  1. ;
  1. S:$G(FILLNUM)="" FILLNUM=0
  1. S:$G(STATEIEN)="" STATEIEN=$$RXSTATE^PSOBPSUT(RXIEN,0) ;P662
  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. K RTSDATA S RTSREC=0 I RECTYPE="V" S RTSREC=1 D LOADRTS^PSOSPMU1(RXIEN,FILLNUM,.RTSDATA)
  1. S PREIEN=$$PREIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
  1. S RPHIEN=$$RPHIEN^PSOSPMUT(RECTYPE,RXIEN,FILLNUM)
  1. D EN^VALM("PSO SPMP VIEW/EXPORT RX")
  1. D FULL^VALM1
  1. Q
  1. ;
  1. HDR ; - Builds the Header section
  1. N LINE1,LINE2,X
  1. K VALMHDR S VALMHDR(1)="Rx: "_$$GET1^DIQ(52,RXIEN,.01)_" - "_$$GET1^DIQ(52,RXIEN,6)
  1. S VALMHDR(1)=VALMHDR(1)_" (Fill: "_$S(FILLNUM["P":"Partial "_$E(FILLNUM,2,9),'FILLNUM:"Original",1:"Refill "_FILLNUM)_")"
  1. S VALMHDR(2)="Patient: "_$$GET1^DIQ(52,RXIEN,2)_" ASAP Version: "_PSOASVER
  1. Q
  1. ;
  1. INIT ; Builds the Body section
  1. N ASAP,LINE
  1. ;
  1. D CLEAN^VALM10 K ^TMP("PSOSPML4",$J) S VALMCNT=0,LINE=0
  1. I PSOASVER="1995" D
  1. . D SETSEG95("PSOSPML4",$$ASAP95^PSOASAP0(RXIEN,+FILLNUM)) S VALMCNT=LINE
  1. I PSOASVER'="1995" D
  1. . S (PSOTTCNT,PSOTPCNT)=0
  1. . D LOADASAP^PSOSPMU0(PSOASVER,"B",.ASAP)
  1. . D SETSEG("ASAP") S VALMCNT=LINE
  1. . S VALMSG="Enter ?? for more actions|* Custom Segment/Element"
  1. Q
  1. ;
  1. SETSEG(ARRNAM) ; Sets list body with ASAP (non-1995) info (Uses Recurisivity - Call itself)
  1. ;Input: ARRNAM - Name of the Array containing the ASAP Definition ('ASAP')
  1. ;
  1. N ARRAY,SEGID,DETLN,VALUE,RXLN,COLUMN,I,TMPARR,SEGTXT,LSTELM
  1. S ARRAY=$Q(@ARRNAM) I '+$P(ARRAY,"(",2) Q
  1. S SEGID=@ARRAY,COLUMN=(($L(ARRAY,",")-1)*4)
  1. ; Segment Not Used by ASAP Version
  1. I $P(ASAP(SEGID),"^",4)="N" D SETSEG(ARRAY) Q
  1. D SETLN^PSOSPMU1("PSOSPML4",$P(ASAP(SEGID),"^")_$S($$CUSSEG^PSOSPMU3(PSOASVER,SEGID):"*",1:"")_" "_$P(ASAP(SEGID),"^",2),0,1)
  1. D SEGCOUNT^PSOSPMUT($P(ASAP(SEGID),"^",6))
  1. K TMPARR S SEGTXT=SEGID
  1. S LSTELM=+$O(ASAP(SEGID,""),-1)
  1. N $ETRAP,$ESTACK S $ETRAP="D ERROR^PSOSPML4"
  1. F I=1:1:LSTELM D
  1. . S VALUE="" I $P(ASAP(SEGID,I),"^",6)'="N" X "S VALUE="_ASAP(SEGID,I,"VAL",1)
  1. . S VALUE=$E(VALUE,1,$P(ASAP(SEGID,I),"^",4))
  1. . S SEGTXT=SEGTXT_$P(ASAP,"^",2)_VALUE
  1. . S RXLN=$S($G(VALUE)'="":VALUE,1:$P(ASAP,"^",2))
  1. . S $E(RXLN,40)=$P(ASAP(SEGID,I),"^")_$S($G(ASAP(SEGID,I,"CUS")):"* ",1:" ")_$P(ASAP(SEGID,I),"^",2)_$S($P(ASAP(SEGID,I),"^",6)="N":" (Not Used)",1:"")
  1. . S TMPARR(I)=RXLN I $G(ASAP(SEGID,I,"CUS")) S TMPARR(I,"HIGH")=1
  1. S SEGTXT=SEGTXT_$S(PSOASVER="3.0":$$TH13^PSOASAP0(),1:$$TH09^PSOASAP0())
  1. ;
  1. F I=1:1 Q:SEGTXT="" D SETLN^PSOSPMU1("PSOSPML4",$E(SEGTXT,1,80)) S SEGTXT=$E(SEGTXT,81,999)
  1. F I=1:1 Q:'$D(TMPARR(I)) D SETLN^PSOSPMU1("PSOSPML4",TMPARR(I),,,+$G(TMPARR(I,"HIGH")))
  1. ;
  1. D SETSEG(ARRAY)
  1. Q
  1. ;
  1. ERROR ; Error Trap Handling to catch errors on user-entered M expression
  1. D SETLN^PSOSPMU1("PSOSPML4",$E($$EC^%ZOSV,1,80))
  1. G UNWIND^%ZTER
  1. ;
  1. SETSEG95(LSTSUB,RECORD) ; Sets list body with ASAP 1995 info
  1. N DSPL,PSOCOL
  1. S PSOCOL=$S(LSTSUB="PSOSPML3":1,1:31)
  1. S:LSTSUB="PSOSPML4" DSPL="VALUE" S $E(DSPL,PSOCOL)="POSITION DESCRIPTION" D SETLN^PSOSPMU1(LSTSUB,DSPL,0,1,0)
  1. S DSPL=$E(RECORD,1,3),$E(DSPL,PSOCOL)="(001-003) Transmission Type Identifier" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,4,9),$E(DSPL,PSOCOL)="(004-009) Bank Identification Number ('VA'_Site#)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,10,11),$E(DSPL,PSOCOL)="(010-011) ASAP Version ('A2': 1995)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,12,13),$E(DSPL,PSOCOL)="(012-013) Transaction Code ('01': Controlled Sub)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,14,25),$E(DSPL,PSOCOL)="(014-025) Pharmacy DEA Number" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,26,45),$E(DSPL,PSOCOL)="(026-045) Patient ID (SSN)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,46,48),$E(DSPL,PSOCOL)="(046-048) Patient's Zip Code (first 3 digits)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,49,56),$E(DSPL,PSOCOL)="(049-056) Patient's DOB (Format: YYYYMMDD)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,57,57),$E(DSPL,PSOCOL)="(057-057) Patient's Gender ('1':Male/'2':Female)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,58,65),$E(DSPL,PSOCOL)="(058-065) Date Filled (Release Date) (YYYYMMDD)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,66,72),$E(DSPL,PSOCOL)="(066-072) Prescription Number (last 7 of Rx IEN)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,73,74),$E(DSPL,PSOCOL)="(073-074) Rx Fill Number" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,75,79),$E(DSPL,PSOCOL)="(075-079) Rx Quantity" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,80,82),$E(DSPL,PSOCOL)="(080-082) Rx Days Supply" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,83,83),$E(DSPL,PSOCOL)="(083-083) Compound Flag (Always '1':Not Compound)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,84,94),$E(DSPL,PSOCOL)="(084-094) NDC (Format: 99999999999)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,95,104),$E(DSPL,PSOCOL)="(095-104) Prescriber's DEA #" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,105,108),$E(DSPL,PSOCOL)="(105-108) Prescriber's DEA Suffix (Not Used)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,109,116),$E(DSPL,PSOCOL)="(109-116) Date Written (Format: YYYYMMDD)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,117,118),$E(DSPL,PSOCOL)="(117-118) Refills Authorized" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,119,119),$E(DSPL,PSOCOL)="(119-119) Origin Code(0:Unknown,1:Written,2:Phone)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,120,121),$E(DSPL,PSOCOL)="(120-121) Customer Location ('03':Outpatient)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,122,128),$E(DSPL,PSOCOL)="(122-128) Diagnosis Code (Not Used)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,129,138),$E(DSPL,PSOCOL)="(129-138) Alternate Prescriber's # (VA #)" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,139,153),$E(DSPL,PSOCOL)="(139-153) Patient's Last Name" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,154,168),$E(DSPL,PSOCOL)="(154-168) Patient's First Name" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,169,198),$E(DSPL,PSOCOL)="(169-198) Patient's Address" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,199,200),$E(DSPL,PSOCOL)="(199-200) Patient's State" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. S DSPL=$E(RECORD,201,209),$E(DSPL,PSOCOL)="(201-209) Patient's Zip Code" D SETLN^PSOSPMU1(LSTSUB,DSPL)
  1. Q
  1. ;
  1. ASAPDEF ; - Invokes Listman for ASAP Definitions
  1. N STATE
  1. S STATE=$$RXSTATE^PSOBPSUT(RXIEN,0)
  1. S PSOASVER=$$GET1^DIQ(58.41,STATE,1,"I") S:PSOASVER="" PSOASVER="4.2"
  1. D FULL^VALM1 W !
  1. D EN^PSOSPML3(PSOASVER,1),INIT S VALMBCK="R"
  1. Q
  1. ;
  1. EXPORT ; - Export Rx
  1. N STATEIEN,PSOASVER,PSOTXRTS,BATIEN,DIR,X,Y,DIRUT,DUOUT,RECTYPE,SCREEN,DFN,PSOSECK,STATELST,LST,MBMST
  1. S VALMBCK="R"
  1. ;
  1. D FULL^VALM1
  1. S SCREEN=$$SCREEN^PSOSPMUT(RXIEN,FILLNUM)
  1. I +SCREEN D Q:$P(SCREEN,"^",3)="E"
  1. . W $C(7) I $P(SCREEN,"^",3)="E" S VALMSG=$P(SCREEN,"^",2) Q
  1. . W !!,"WARNING: ",$P(SCREEN,"^",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. ; PSO*7*625: PSU-14 Begin
  1. S PSOSECK=$$SECKEY^PSOSPMA3()
  1. S DIR("??")="^D ASAPHELP^PSOSPMU2(PSOASVER,""DSP"",1)"
  1. I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM) D
  1. . S DIR("PRE")="D VRECMSG^PSOSPML4(X,RXIEN,FILLNUM,PSOSECK)"
  1. . S DIR(0)="S^N:NEW;R:REVISE"_$S($G(PSOSECK):";V:VOID",1:"")
  1. . S DIR("L",3)=" N NEW"
  1. . S DIR("L",4)=" R REVISE"
  1. . S DIR("L")=$S($G(PSOSECK):" V VOID",1:" (V) VOID")
  1. . ; PSO*7*625: PSU-14 End
  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)) K DIRUT,DUOUT,DIR Q
  1. S RECTYPE=Y
  1. ;
  1. W ! K DIR,DTOUT,DUOUT
  1. I (RECTYPE'="V") D
  1. . S DIR("A",1)="The Prescription Fill will be transmitted to the State(s)",DIR("A",2)=""
  1. S DIR("A")="Confirm",DIR(0)="Y",DIR("B")="N"
  1. D ^DIR I $G(DTOUT)!$G(DUOUT)!'Y Q
  1. W ?40,"Please wait..."
  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. 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. . ;
  1. . I 'STATEIEN D Q
  1. . . S VALMSG="No State on file for Division "_$$GET1^DIQ(59,$$RXSITE^PSOBPSUT(RXIEN,0),.01) W $C(7)
  1. . I $P($$SPOK^PSOSPMUT(STATEIEN),"^")=-1 D Q ;P659
  1. . . S VALMSG=$P($$SPOK^PSOSPMUT(STATEIEN),"^",2) W $C(7)
  1. . . I $D(VALMSG) W !!!,VALMSG,"...NO BATCH SENT!",!
  1. . ;
  1. . K ^TMP("PSOSPMRX",$J) S ^TMP("PSOSPMRX",$J,STATEIEN,RXIEN,FILLNUM)=RECTYPE
  1. . S BATIEN=$$BLDBAT^PSOSPMU1($S(RECTYPE="V"&(PSOASVER="1995"):"VD",1:"RX"))
  1. . ;
  1. . I (($$GET1^DIQ(58.42,BATIEN,2,"I")="VD")&'PSOTXRTS) D
  1. . . D EXMSG^PSOSPML2(1) W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS Q:POP U IO
  1. . . W ! D EXPORT^PSOSPMUT(BATIEN,"VIEW")
  1. . . D ^%ZISC N DIE,DA,DR S DIE="^PS(58.42,",DA=BATIEN
  1. . . S DR="6///<Manual Web Upload>7////"_DUZ_";9///"_$$NOW^XLFDT()
  1. . . D ^DIE
  1. . E D EXPORT^PSOSPMUT(BATIEN,"EXPORT")
  1. . Q
  1. K DIR S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. VIEW ; - Rx View Action
  1. N VALMCNT,PSOTITLE,DFN,PSOLSTLN
  1. S PSOTITLE=VALM("TITLE")
  1. ;
  1. ; DO structure used to avoid losing variables RXIEN,FILLNUM,LINE,PSOTITLE
  1. DO
  1. . N PSOVDA,DA,PS
  1. . S (PSOVDA,DA)=RXIEN
  1. . N RXIEN,FILLNUM,LINE,PSOTITLE D DP^PSORXVW
  1. ;
  1. S VALMBCK="R",VALM("TITLE")=PSOTITLE
  1. Q
  1. ;
  1. MP ; - Patient Medication Profile
  1. N SITEIEN,PATIENT,SITE,DFN
  1. D FULL^VALM1 W !
  1. S SITEIEN=+$$RXSITE^PSOBPSUT(RXIEN,0) S:$G(PSOSITE) SITE=PSOSITE
  1. S PATIENT=+$$GET1^DIQ(52,RXIEN,2,"I")
  1. D LST^PSOPMP0(SITEIEN,PATIENT) S VALMBCK="R"
  1. Q
  1. ;
  1. EXIT ; Listman Exit
  1. K ^TMP("PSOSPML4",$J)
  1. Q
  1. HELP ; Listman Help
  1. Q
  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. VRECMSG(X,RXIEN,FILLNUM,PSOSECK) ; Inform user if VOID selected without PSO SPMP ADMIN key
  1. Q:$D(DTOUT) Q:(X="^")!(X="?")
  1. I $$RXRLDT^PSOBPSUT(RXIEN,FILLNUM),$$UP^XLFSTR($E(X))="V",'PSOSECK D Q
  1. .W !!,"The 'PSO SPMP ADMIN' key is required to select this record type."
  1. Q