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

AGED11B.m

Go to the documentation of this file. 
  1. AGED11B ; IHS/ASDS/EFG - RHI ARRAY AND DATES ;    
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1.  ;
  1. SETARRAY ;LOAD ARRAY WITH PATIENT'S RHI RECORDS
  1.  K AGRHI1,AGRHI2,AG("RHISEL"),AG("SELH")
  1.  I '$D(^AUPNRHI("B",DFN)) W !!,"No Restricted Health Information on file" Q
  1.  W !!,"Restricted Health Information on File"
  1.  W !!,?2,"#",?5,"Patient",?28,"Current",?41,"Status"
  1.  W !,?5,"Name",?28,"Status",?41,"Entered on"
  1.  W !
  1.  S (RHINO,AGSEL)=0
  1.  F  S RHINO=$O(^AUPNRHI("B",DFN,RHINO)) Q:'RHINO  D
  1.  . S RHIREC=$G(^AUPNRHI(RHINO,0))
  1.  . S RHIPTIEN=$P(RHIREC,U)
  1.  . S RHIPAT=$P($G(^DPT(RHIPTIEN,0)),U)
  1.  . S RHIRHI=$P(RHIREC,U,2)
  1.  . S RHISTAT=$P(RHIREC,U,3)
  1.  . S RHIDA=$S(RHISTAT="P":1,RHISTAT="A":2,RHISTAT="N":3,RHISTAT="R":4,1:5)
  1.  . I RHIDA=1 S RHIENT=$P($G(^AUPNRHI(RHINO,RHIDA)),U,3)
  1.  . I RHIDA=5 S RHIENT=$P($G(^AUPNRHI(RHINO,RHIDA)),U,2)
  1.  . I RHIDA'=1&(RHIDA'=5) S RHIENT=$P($G(^AUPNRHI(RHINO,RHIDA)),U,4)
  1.  . I RHIENT="" S RHIENT=999999 I RHISTAT="" S RHISTAT="IMCOMPLETE RECORD"
  1.  . S AGRHI1(RHIENT)=RHIPAT_"^"_RHISTAT_"^"_RHIENT_"^"_RHIRHI_"^"_RHINO
  1.  S ENTDAT=""
  1.  F  S ENTDAT=$O(AGRHI1(ENTDAT),-1) Q:'ENTDAT  D
  1.  . S AGSEL=AGSEL+1
  1.  . S AGRHI2(AGSEL)=$G(AGRHI1(ENTDAT))
  1.  . S RHIPAT=$P(AGRHI2(AGSEL),U)
  1.  . S RHISTAT=$P(AGRHI2(AGSEL),U,2)
  1.  . S RHIENT=$P(AGRHI2(AGSEL),U,3)
  1.  . S RHIRHI=$P(AGRHI2(AGSEL),U,4)
  1.  . W !,?2,AGSEL,?5,RHIPAT,?31,RHISTAT,?41,$S(RHIENT'=999999:$E(RHIENT,4,5)_"/"_$E(RHIENT,6,7)_"/"_($E(RHIENT,1,3)+1700),1:"")
  1.  . W !,RHIRHI,!
  1.  S AG("SELH")=AGSEL
  1.  K DIR,DTOUT,DFOUT,DUOUT,DLOUT,DIROUT
  1.  S DIR("A")="Select  1 - "_AG("SELH")_" ( Press ENTER to add a new record or ""^"" to exit ) "
  1.  S DIR(0)="FO"
  1.  D ^DIR S AG("RHISEL")=Y K DIR
  1.  Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
  1.  Q:AG("RHISEL")=""
  1.  I AG("RHISEL")<1!(AG("RHISEL")>AG("SELH")) W !,"You must enter a number from 1 - ",AG("SELH") H 2 G SETARRAY
  1.  S AG("RHISEL")=$P(AGRHI2(AG("RHISEL")),U,5)
  1.  K RHINO,RHIDA,RHIREC,RHIPTIEN,RHIPAT,RHIRHI,RHISTAT,RHIENT,AGSEL
  1.  Q
  1. DATES ;
  1.  I $P($G(^AUPNRHI(DA,0)),U,3)="A" D ADATE Q
  1.  I $P($G(^AUPNRHI(DA,0)),U,3)="N" D NDATE Q
  1.  I $P($G(^AUPNRHI(DA,0)),U,3)="P" D PDATE Q
  1.  I $P($G(^AUPNRHI(DA,0)),U,3)="R" D RDATE Q
  1.  I $P($G(^AUPNRHI(DA,0)),U,3)="E" D EDATE Q
  1.  Q
  1. ADATE ;ENTER/EDIT APPROVED DATE
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=".21;.22;.23////^S X=DUZ;.24////^S X=AG(""STAMP"")"
  1.  D ^DIE Q:$D(Y)>9
  1.  Q
  1. NDATE ;ENTER/EDIT NOT APPROVED DATE
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=".31;.32;.33////^S X=DUZ;.34////^S X=AG(""STAMP"")"
  1.  D ^DIE Q:$D(Y)>9
  1.  Q
  1. PDATE ;ENTER/EDIT PENDING DATE
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=".11;.12////^S X=DUZ;.13////^S X=AG(""STAMP"")"
  1.  D ^DIE Q:$D(Y)>9
  1.  Q
  1. RDATE ;ENTER/EDIT REVOKED DATE
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=".41;.42;.43////^S X=DUZ;.44////^S X=AG(""STAMP"")"
  1.  D ^DIE Q:$D(Y)>9
  1.  Q
  1. EDATE ;ENTER/EDIT ENTERED IN ERROR DATE
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=".51////^S X=DUZ;.52////^S X=AG(""STAMP"")"
  1.  D ^DIE Q:$D(Y)>9
  1.  Q
  1. FINDRHI ;EP - FIND THE PATIENT'S LAST RHI ENTRY AND DISPLAY ON SCREEN
  1.  K AG("RHISTAT")
  1.  I $D(RHIFLAG)&(RHIFLAG="A") W "APPROVED" Q
  1.  K AG("RHINUM")
  1.  S AG("RHINUM")=$O(^AUPNRHI("B",DFN,""),-1)
  1.  I AG("RHINUM")>0  D
  1.  . S AG("RHISTAT")=$P($G(^AUPNRHI(AG("RHINUM"),0)),U,3)
  1.  . S AG("STATUS")=$S(AG("RHISTAT")="A":"APPROVED",AG("RHISTAT")="N":"NOT APPROVED",AG("RHISTAT")="R":"REVOKED",AG("RHISTAT")="P":"PENDING",1:"ENTERED IN ERROR")
  1.  . W AG("STATUS")
  1.  Q
  1. RHICHK ;EP - CHECK FOR EXISTANCE OF RHI RECORD
  1.  K AG("RHICHK")
  1.  S AG("RHICHK")=$O(^AUPNRHI("B",DFN,""))
  1.  Q
  1. ADDRHI ;EP - ADD AN RHI RECORD
  1.  N DIC,DIE,DR,DA,DLAYGO,Y
  1.  K AG("STAMP")
  1.  S DIC="^AUPNRHI("
  1.  S DLAYGO=9000039
  1.  S DIC(0)="L"
  1.  I '$D(AG("RHISEL")) S X="`"_DFN
  1.  I $D(AG("RHISEL"))  D
  1.  . I AG("RHISEL")="" S X="`"_DFN
  1.  D ^DIC
  1.  Q:$D(DTOUT)!$D(DUOUT)!(Y=-1)
  1.  S DIE=DIC
  1.  K DIC,DA,DR,X
  1.  S DA=+Y
  1.  D NOW^%DTC S AG("STAMP")=%
  1.  S DR=.02
  1.  D ^DIE
  1.  I $P($G(^AUPNRHI(DA,0)),U,2)="" S DIK="^AUPNRHI(" D ^DIK Q
  1.  S DR=.03
  1.  D ^DIE
  1.  D DATES
  1.  I '$G(^AUPNRHI(DA,1))&('$G(^AUPNRHI(DA,2)))&('$G(^AUPNRHI(DA,3)))&('$G(^AUPNRHI(DA,4)))&('$G(^AUPNRHI(DA,5))) S DR=".01////@" D ^DIE Q
  1.  K AG("RHISEL"),AGRHI1,AGRHI2
  1.  Q
  1. EDITRHI ;EP - EDIT AN RHI RECORD
  1.  N DIE,DR,X,Y,REC
  1.  S DIC(0)="MQZ"
  1.  D SETARRAY
  1.  I AG("RHISEL")="" G ADDRHI
  1.  Q:$D(DTOUT)!$D(DUOUT)
  1.  S DIC="^AUPNRHI("
  1.  S DA=AG("RHISEL")
  1.  S DIC(0)="AEMQZ"
  1.  S DIE=DIC
  1.  S DR=".02;.03"
  1.  S AG("STAT")=$P($G(^AUPNRHI(DA,0)),U,3)
  1.  D ^DIE Q:$D(Y)>9
  1.  Q:$D(DTOUT)!$D(DUOUT)
  1.  D DATES
  1.  I $D(Y)>9  D
  1.  . S DR=".03////^S X=AG(""STAT"")"
  1.  . D ^DIE
  1.  K AG("RHISEL"),AGRHI1,AGRHI2
  1.  Q