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

APSPESLR.m

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