APSPESLR ;IHS/BWF - Report for APSP REFILL REQUEST file ;14-Oct-2009 14:53;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23,2004
EN ; -- main entry point for APSP LM REFILL REQUEST
N SRCHSEL,APSPPOP,DONE
S APSPPOP=0
K ^XTMP("APSPESLR",$J)
D FULL^VALM1
S SRCHSEL=$$DIR^APSPUTIL("SO^D:Date Range;P:Patient Name;PR:Provider;S:Status","Search by",,.APSPPOP)
I APSPPOP D BACK^APSPESLP Q
S SCHLOGIC=$S(SRCHSEL="P":"PAT",SRCHSEL="PR":"PROV",SRCHSEL="S":"STAT",1:"DR") D @SCHLOGIC
I '$D(^XTMP("APSPESLR",$J)) S DONE=$$DIR^APSPUTIL("FO","No data found, press <RETURN> to continue") D BACK^APSPESLP Q
D EN^VALM("APSP LM REFREQ REPORT")
K ^XTMP("APSPESLR",$J)
Q
;
HDR ; -- header code
Q
;
INIT ; -- init variables and list array
N LINE,LDT,IEN
S (LINE,VALMCNT)=0
S LDT=0 F S LDT=$O(^XTMP("APSPESLR",$J,LDT)) Q:'LDT D
.S IEN=0 F S IEN=$O(^XTMP("APSPESLR",$J,LDT,IEN)) Q:'IEN D
..S DAT=$G(^XTMP("APSPESLR",$J,LDT,IEN))
..S PATN=$P(DAT,U,2),DRUG=$P(DAT,U,6),PROV=$P(DAT,U,3),DATE=$P(DAT,U,4)
..S LINE=LINE+1,VALMCNT=VALMCNT+1
..S LINEVAR=""
..S LINEVAR=$$SETFLD^VALM1(LINE_".",LINEVAR,"ITEM")
..S LINEVAR=$$SETFLD^VALM1(PATN,LINEVAR,"PATIENT")
..S LINEVAR=$$SETFLD^VALM1(DRUG,LINEVAR,"DRUG")
..S LINEVAR=$$SETFLD^VALM1(PROV,LINEVAR,"PROV")
..S LINEVAR=$$SETFLD^VALM1(DATE,LINEVAR,"DATE")
..D SET^VALM10(LINE,LINEVAR,IEN)
Q
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAN^VALM10
D FULL^VALM1
K ^XTMP("APSPESLR",$J)
;D BACK^APSPESLP
Q
;
EXPND ; -- expand code
Q
DR ; date range
N APSPPOP,START,END
S APSPPOP=0
D ASKDATES^APSPUTIL(.START,.END,.APSPPOP,,DT) Q:APSPPOP
S LSTART=START-.01,LEND=END+.99
F S LSTART=$O(^APSPRREQ("D",LSTART)) Q:'LSTART!(LSTART>LEND) D
.S RRIEN=0 F S RRIEN=$O(^APSPRREQ("D",LSTART,RRIEN)) Q:'RRIEN D
..D ADDREC(RRIEN)
Q
PAT ; patient name
N APSPPOP,PAT,RRIEN
S APSPPOP=0
S PAT=$$DIR^APSPUTIL("9000001,.01","Select Patient",,,.APSPPOP) Q:APSPPOP
S DFN=+PAT Q:'DFN
S RRIEN=0 F S RRIEN=$O(^APSPRREQ("E",DFN,RRIEN)) Q:'RRIEN D
.D ADDREC(RRIEN)
Q
PHARM ; pharmacy
N APSPPOP,PHARM,RRIEN,SPHARM
S APSPPOP=0
S PHARM=$$DIR^APSPUTIL("9009033.91,1.7","Select Pharmacy",,,.APSPPOP) Q:APSPPOP
S SPHARM=+PHARM Q:'SPHARM
S RRIEN=0 F S RRIEN=$O(^APSPRREQ("APHM",SPHARM,RRIEN)) Q:'RRIEN D
.D ADDREC(RRIEN)
Q
PROV ;
N APSPPOP,PROV,RRIEN,SPROV
S APSPPOP=0
S PROV=$$DIR^APSPUTIL("9009033.91,1.3","Select Provider",,,.APSPPOP) Q:APSPPOP
S SPROV=+PROV Q:'SPROV
S RRIEN=0 F S RRIEN=$O(^APSPRREQ("APRV",SPROV,RRIEN)) Q:'RRIEN D
.D ADDREC(RRIEN)
Q
STAT ;
N APSPPOP,STAT,RRIEN
S APSPPOP=0
S STAT=$$DIR^APSPUTIL("9009033.91,.03","Select Status",,,.APSPPOP) Q:APSPPOP
I '$L(STAT) Q
S RRIEN=0 F S RRIEN=$O(^APSPRREQ("F",STAT,RRIEN)) Q:'RRIEN D
.D ADDREC(RRIEN)
Q
ADDREC(IEN) ;
N DATA,F,IENS,MSGID,MSGDTM,MSGPRV,MSGSTAT,MSGPAT,MSGDRUG,MSGPHARM
S F=9009033.91,IENS=IEN_","
D GETS^DIQ(9009033.91,IEN,"**","IE","DATA")
; get some variables and have fun
S MSGID=$G(DATA(F,IENS,.01,"E"))
S MSGIDTM=$G(DATA(F,IENS,.04,"I")) I 'MSGIDTM Q
S MSGDTM=$$FMTE^XLFDT($P($G(DATA(F,IENS,.04,"E")),"."),"5Z")
S MSGPRV=$G(DATA(F,IENS,1.3,"E"))
S MSGSTAT=$G(DATA(F,IENS,.03,"E"))
S MSGPAT=$G(DATA(F,IENS,1.2,"E"))
S MSGDRUG=$G(DATA(F,IENS,1.1,"E"))
S MSGPHARM=$G(DATA(F,IENS,1.7,"E"))
S MSGORD=$G(DATA(F,IENS,1.1,"I"))
S ^XTMP("APSPESLR",$J,MSGIDTM,IEN)=MSGID_U_MSGPAT_U_MSGPRV_U_MSGDTM_U_MSGSTAT_U_MSGDRUG_U_MSGPHARM_U_MSGORD
Q
; prompt for item and display pertinent information to the user.
VIEW ;
N IEN,SSRTEXT,LINE,DONE
S IEN=$$SELITEM^APSPESLP()
I 'IEN D BACK Q
D PREPPTXT("SSRTEXT",IEN)
D FULL^VALM1
I $D(SSRTEXT) D
.S $P(LINE,"-",80)="" W !,LINE,!,"Displaying order information:",!,"-----------------------------",!
.D FULL^VALM1
.S I=0 F S I=$O(SSRTEXT(I)) Q:'I W !,SSRTEXT(I)
.W !,LINE
S DONE=$$DIRYN^APSPUTIL("Press Return to continue")
D BACK
Q
PREPPTXT(RET,RRIEN) ;
N SIGNODE,SIG
S RRIEN=$G(RRIEN,0)
S SIGNODE=$O(^APSPRREQ(RRIEN,3,0)) I 'SIGNODE S SIG=""
I SIGNODE S SIG=$G(^APSPRREQ(RRIEN,3,SIGNODE,0))
S @RET@(1)="Pharmacy: "_$$GET1^DIQ(9009033.91,RRIEN,1.7,"E")
S @RET@(2)="Drug description: "_$$GET1^DIQ(9009033.91,RRIEN,1.1,"E")
S @RET@(3)="Quantity: "_$$GET1^DIQ(9009033.91,RRIEN,1.4,"E")
S @RET@(4)="Days Supply: "_$$GET1^DIQ(9009033.91,RRIEN,1.5,"E")
S @RET@(5)="Sig-Directions: "_$G(SIG)
S @RET@(6)="Provider: "_$$GET1^DIQ(9009033.91,RRIEN,1.3,"E")
S @RET@(7)="Status: "_$$GET1^DIQ(9009033.91,RRIEN,.03,"E")
S @RET@(8)="Last Updated: "_$$FMTE^XLFDT($$GET1^DIQ(9009033.91,RRIEN,.07,"I"),"5Z")
S @RET@(9)="OE/RR Order #: "_$$GET1^DIQ(9009033.91,RRIEN,.02,"E")
S @RET@(10)="Patient: "_$$GET1^DIQ(9009033.91,RRIEN,1.2,"E")
Q
BACK ;
S VALMBCK="R" D INIT Q
Q
APSPESLR ;IHS/BWF - Report for APSP REFILL REQUEST file ;14-Oct-2009 14:53;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1008**;Sep 23,2004
EN ; -- main entry point for APSP LM REFILL REQUEST
+1 NEW SRCHSEL,APSPPOP,DONE
+2 SET APSPPOP=0
+3 KILL ^XTMP("APSPESLR",$JOB)
+4 DO FULL^VALM1
+5 SET SRCHSEL=$$DIR^APSPUTIL("SO^D:Date Range;P:Patient Name;PR:Provider;S:Status","Search by",,.APSPPOP)
+6 IF APSPPOP
DO BACK^APSPESLP
QUIT
+7 SET SCHLOGIC=$SELECT(SRCHSEL="P":"PAT",SRCHSEL="PR":"PROV",SRCHSEL="S":"STAT",1:"DR")
DO @SCHLOGIC
+8 IF '$DATA(^XTMP("APSPESLR",$JOB))
SET DONE=$$DIR^APSPUTIL("FO","No data found, press <RETURN> to continue")
DO BACK^APSPESLP
QUIT
+9 DO EN^VALM("APSP LM REFREQ REPORT")
+10 KILL ^XTMP("APSPESLR",$JOB)
+11 QUIT
+12 ;
HDR ; -- header code
+1 QUIT
+2 ;
INIT ; -- init variables and list array
+1 NEW LINE,LDT,IEN
+2 SET (LINE,VALMCNT)=0
+3 SET LDT=0
FOR
SET LDT=$ORDER(^XTMP("APSPESLR",$JOB,LDT))
IF 'LDT
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^XTMP("APSPESLR",$JOB,LDT,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+5 SET DAT=$GET(^XTMP("APSPESLR",$JOB,LDT,IEN))
+6 SET PATN=$PIECE(DAT,U,2)
SET DRUG=$PIECE(DAT,U,6)
SET PROV=$PIECE(DAT,U,3)
SET DATE=$PIECE(DAT,U,4)
+7 SET LINE=LINE+1
SET VALMCNT=VALMCNT+1
+8 SET LINEVAR=""
+9 SET LINEVAR=$$SETFLD^VALM1(LINE_".",LINEVAR,"ITEM")
+10 SET LINEVAR=$$SETFLD^VALM1(PATN,LINEVAR,"PATIENT")
+11 SET LINEVAR=$$SETFLD^VALM1(DRUG,LINEVAR,"DRUG")
+12 SET LINEVAR=$$SETFLD^VALM1(PROV,LINEVAR,"PROV")
+13 SET LINEVAR=$$SETFLD^VALM1(DATE,LINEVAR,"DATE")
+14 DO SET^VALM10(LINE,LINEVAR,IEN)
End DoDot:2
End DoDot:1
+15 QUIT
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAN^VALM10
+2 DO FULL^VALM1
+3 KILL ^XTMP("APSPESLR",$JOB)
+4 ;D BACK^APSPESLP
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
DR ; date range
+1 NEW APSPPOP,START,END
+2 SET APSPPOP=0
+3 DO ASKDATES^APSPUTIL(.START,.END,.APSPPOP,,DT)
IF APSPPOP
QUIT
+4 SET LSTART=START-.01
SET LEND=END+.99
+5 FOR
SET LSTART=$ORDER(^APSPRREQ("D",LSTART))
IF 'LSTART!(LSTART>LEND)
QUIT
Begin DoDot:1
+6 SET RRIEN=0
FOR
SET RRIEN=$ORDER(^APSPRREQ("D",LSTART,RRIEN))
IF 'RRIEN
QUIT
Begin DoDot:2
+7 DO ADDREC(RRIEN)
End DoDot:2
End DoDot:1
+8 QUIT
PAT ; patient name
+1 NEW APSPPOP,PAT,RRIEN
+2 SET APSPPOP=0
+3 SET PAT=$$DIR^APSPUTIL("9000001,.01","Select Patient",,,.APSPPOP)
IF APSPPOP
QUIT
+4 SET DFN=+PAT
IF 'DFN
QUIT
+5 SET RRIEN=0
FOR
SET RRIEN=$ORDER(^APSPRREQ("E",DFN,RRIEN))
IF 'RRIEN
QUIT
Begin DoDot:1
+6 DO ADDREC(RRIEN)
End DoDot:1
+7 QUIT
PHARM ; pharmacy
+1 NEW APSPPOP,PHARM,RRIEN,SPHARM
+2 SET APSPPOP=0
+3 SET PHARM=$$DIR^APSPUTIL("9009033.91,1.7","Select Pharmacy",,,.APSPPOP)
IF APSPPOP
QUIT
+4 SET SPHARM=+PHARM
IF 'SPHARM
QUIT
+5 SET RRIEN=0
FOR
SET RRIEN=$ORDER(^APSPRREQ("APHM",SPHARM,RRIEN))
IF 'RRIEN
QUIT
Begin DoDot:1
+6 DO ADDREC(RRIEN)
End DoDot:1
+7 QUIT
PROV ;
+1 NEW APSPPOP,PROV,RRIEN,SPROV
+2 SET APSPPOP=0
+3 SET PROV=$$DIR^APSPUTIL("9009033.91,1.3","Select Provider",,,.APSPPOP)
IF APSPPOP
QUIT
+4 SET SPROV=+PROV
IF 'SPROV
QUIT
+5 SET RRIEN=0
FOR
SET RRIEN=$ORDER(^APSPRREQ("APRV",SPROV,RRIEN))
IF 'RRIEN
QUIT
Begin DoDot:1
+6 DO ADDREC(RRIEN)
End DoDot:1
+7 QUIT
STAT ;
+1 NEW APSPPOP,STAT,RRIEN
+2 SET APSPPOP=0
+3 SET STAT=$$DIR^APSPUTIL("9009033.91,.03","Select Status",,,.APSPPOP)
IF APSPPOP
QUIT
+4 IF '$LENGTH(STAT)
QUIT
+5 SET RRIEN=0
FOR
SET RRIEN=$ORDER(^APSPRREQ("F",STAT,RRIEN))
IF 'RRIEN
QUIT
Begin DoDot:1
+6 DO ADDREC(RRIEN)
End DoDot:1
+7 QUIT
ADDREC(IEN) ;
+1 NEW DATA,F,IENS,MSGID,MSGDTM,MSGPRV,MSGSTAT,MSGPAT,MSGDRUG,MSGPHARM
+2 SET F=9009033.91
SET IENS=IEN_","
+3 DO GETS^DIQ(9009033.91,IEN,"**","IE","DATA")
+4 ; get some variables and have fun
+5 SET MSGID=$GET(DATA(F,IENS,.01,"E"))
+6 SET MSGIDTM=$GET(DATA(F,IENS,.04,"I"))
IF 'MSGIDTM
QUIT
+7 SET MSGDTM=$$FMTE^XLFDT($PIECE($GET(DATA(F,IENS,.04,"E")),"."),"5Z")
+8 SET MSGPRV=$GET(DATA(F,IENS,1.3,"E"))
+9 SET MSGSTAT=$GET(DATA(F,IENS,.03,"E"))
+10 SET MSGPAT=$GET(DATA(F,IENS,1.2,"E"))
+11 SET MSGDRUG=$GET(DATA(F,IENS,1.1,"E"))
+12 SET MSGPHARM=$GET(DATA(F,IENS,1.7,"E"))
+13 SET MSGORD=$GET(DATA(F,IENS,1.1,"I"))
+14 SET ^XTMP("APSPESLR",$JOB,MSGIDTM,IEN)=MSGID_U_MSGPAT_U_MSGPRV_U_MSGDTM_U_MSGSTAT_U_MSGDRUG_U_MSGPHARM_U_MSGORD
+15 QUIT
+16 ; prompt for item and display pertinent information to the user.
VIEW ;
+1 NEW IEN,SSRTEXT,LINE,DONE
+2 SET IEN=$$SELITEM^APSPESLP()
+3 IF 'IEN
DO BACK
QUIT
+4 DO PREPPTXT("SSRTEXT",IEN)
+5 DO FULL^VALM1
+6 IF $DATA(SSRTEXT)
Begin DoDot:1
+7 SET $PIECE(LINE,"-",80)=""
WRITE !,LINE,!,"Displaying order information:",!,"-----------------------------",!
+8 DO FULL^VALM1
+9 SET I=0
FOR
SET I=$ORDER(SSRTEXT(I))
IF 'I
QUIT
WRITE !,SSRTEXT(I)
+10 WRITE !,LINE
End DoDot:1
+11 SET DONE=$$DIRYN^APSPUTIL("Press Return to continue")
+12 DO BACK
+13 QUIT
PREPPTXT(RET,RRIEN) ;
+1 NEW SIGNODE,SIG
+2 SET RRIEN=$GET(RRIEN,0)
+3 SET SIGNODE=$ORDER(^APSPRREQ(RRIEN,3,0))
IF 'SIGNODE
SET SIG=""
+4 IF SIGNODE
SET SIG=$GET(^APSPRREQ(RRIEN,3,SIGNODE,0))
+5 SET @RET@(1)="Pharmacy: "_$$GET1^DIQ(9009033.91,RRIEN,1.7,"E")
+6 SET @RET@(2)="Drug description: "_$$GET1^DIQ(9009033.91,RRIEN,1.1,"E")
+7 SET @RET@(3)="Quantity: "_$$GET1^DIQ(9009033.91,RRIEN,1.4,"E")
+8 SET @RET@(4)="Days Supply: "_$$GET1^DIQ(9009033.91,RRIEN,1.5,"E")
+9 SET @RET@(5)="Sig-Directions: "_$GET(SIG)
+10 SET @RET@(6)="Provider: "_$$GET1^DIQ(9009033.91,RRIEN,1.3,"E")
+11 SET @RET@(7)="Status: "_$$GET1^DIQ(9009033.91,RRIEN,.03,"E")
+12 SET @RET@(8)="Last Updated: "_$$FMTE^XLFDT($$GET1^DIQ(9009033.91,RRIEN,.07,"I"),"5Z")
+13 SET @RET@(9)="OE/RR Order #: "_$$GET1^DIQ(9009033.91,RRIEN,.02,"E")
+14 SET @RET@(10)="Patient: "_$$GET1^DIQ(9009033.91,RRIEN,1.2,"E")
+15 QUIT
BACK ;
+1 SET VALMBCK="R"
DO INIT
QUIT
+2 QUIT
