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

AGED11A.m

Go to the documentation of this file. 
  1. AGED11A ; IHS/ASDS/EFG - EDIT DOCUMENT SUMMARY PAGE (PAGE 9) ; MAR 19, 2010
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,7,8**;AUG 25, 2005
  1.  ;
  1.  ;AG*7.1*7 - Modified code to allow the new page 10 to be called
  1.  ;
  1. VAR D DRAW
  1.  Q:$D(AGSEENLY)
  1.  K DIR
  1.  S DIR("?")="Enter your choice now."
  1.  S DIR("?",1)="You may enter the item number of the field you wish to edit,"
  1.  S DIR("?",2)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
  1.  S DIR("?",3)="the page you wish to jump to, OR enter '^' to go back one page"
  1.  S DIR("?",4)="OR, enter '^^' to exit the edit screens, OR RETURN to go back to the main menu."
  1.  S DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
  1.  D READ^AGED1
  1.  I $D(MYERRS("C","E")),(Y'?1N.N),(Y'=AGOPT("ESCAPE")) W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 G VAR
  1.  Q:Y=AGOPT("ESCAPE")
  1.  Q:$D(DTOUT)!$D(DFOUT)
  1.  G ^AGED11:$D(DUOUT)&'$D(AGXTERN),VAR:$D(AG("ERR")),END:$D(DLOUT)!(Y["N") G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))
  1.  I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 G VAR
  1.  W !!
  1. CC ;S AG("C")="EMOD,CHSTAT,PRIVA,LDOC,ADVDIRED,ROI,AOB,NPP,ACK,RHI"
  1.  S AG("C")="EMOD,CHSTAT,LDOC,ADVDIRED,ROI,AOB,NPP,ACK,RHI"
  1. C ;EP - Edit multiple fields on a Reg edit page.
  1.  S AGY=Y F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N"))  D @($P(AG("C"),",",AG("SEL")))
  1.  D UPDATE1^AGED(DUZ(2),DFN,8,"") K AGI,AGY
  1.  G VAR
  1. END K AG,DFOUT,DQOUT,DTOUT,DA,DIC,DIE,DR,AGSCRN,Y,NUMCASES,CNT,MOD,MOVDT
  1.  K ROUTID
  1.  Q:$D(AGXTERN)
  1.  Q:$D(DIROUT)
  1.  Q:$D(AGSEENLY)
  1.  G ^AGED10A
  1. EMOD ;LOOKUP FOR ELIGIBILITY MODIFIER FIELD
  1.  N DIC,DA,X,Y,DIR
  1.  K DTOUT,DUOUT
  1.  S DIR(0)="F"
  1.  I $O(^AUPNPAT(DFN,34,0)) S DIR("A")="Do you wish to E(dit) or A(dd) an Eligibility Modifier ? "
  1.  E  S DIR("A")="Do you wish to A(dd) an Eligibility Modifier ? "
  1.  D ^DIR
  1.  Q:$D(DTOUT)!(Y="^")
  1.  I Y'="E"&(Y'="A") G EMOD
  1.  I Y="A" D ADDMOD Q
  1.  I Y="E",$O(^AUPNPAT(DFN,34,0)) D EDITMOD Q
  1.  Q
  1. ADDMOD ;ADD A NEW MODIFIER TO AUPNPAT FIELD 3401
  1.  N DIR,X,Y
  1.  N DIC,ELIG,X,Y
  1.  S DIC="^AUPNELM("
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select modifier : "
  1.  S DIC("S")="I $P(^(0),U,2)=AGELSTS"  ;AGELSTS=CURRENT ELIG STATUS
  1.  D ^DIC
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:+Y'>0
  1.  S ELIG=Y
  1.  N DA,DIC,DD,DLAYGO,DO,X,Y
  1.  K DD,DO
  1.  S X=$P(ELIG,U)
  1.  S REC=X
  1.  S DINUM=+ELIG
  1.  S DA(1)=DFN
  1.  S DIC="^AUPNPAT("_DA(1)_",34,"
  1.  S DIC(0)="L"
  1.  S DIC("P")=$P($G(^DD(9000001,3401,0)),U,2)
  1.  S DLAYGO=9000001.03401
  1.  D FILE^DICN
  1.  K DINUM
  1.  D CHKMOD
  1.  Q
  1. EDITMOD ;
  1.  N DIE,DR,X,Y,DIR,REC
  1.  S DIC(0)="AEMQZ"
  1.  S DA(1)=DFN
  1.  S DIC="^AUPNPAT("_DA(1)_",34,"
  1.  D ^DIC S REC=+Y
  1.  Q:$D(DTOUT)!($D(DUOUT))!(Y=-1)
  1.  S DIE=DIC
  1.  S DA=REC
  1.  S DR=".01"
  1.  D ^DIE
  1.  Q:$D(Y)    ;USER ENTERED AN "^" NO CHANGE MADE
  1.  S ELIG=$P($G(^AUPNELM(REC,0)),U)
  1.  D CHKMOD
  1.  Q
  1. CHKMOD ;CHECK MOD FOR "MOVED OUT OF CHSDA" OR "DOUBTFUL CASES" TO
  1.  ;ALLOW UPDATE OF SECONDARY FIELDS
  1.  ;IF MODIFIER IS "MOVED FROM CHSDA", ENTER DATE FIELD
  1. MD ;
  1.  I REC=10&$D(^AUPNPAT(DFN,34,10,0)) D
  1.  . S DIE="^AUPNPAT("
  1.  . S DA=DFN
  1.  . S DR=4901
  1.  . D ^DIE
  1.  . I $P($G(^AUPNPAT(DFN,49)),U)="" G MD
  1.  ;IF MODIFIER "MOVED FROM CHSDA" WAS DELETED, DELETE DATE FIELD
  1.  I '$D(^AUPNPAT(DFN,34,10,0))&($D(^AUPNPAT(DFN,49))) K ^AUPNPAT(DFN,49)
  1.  ;IF MODIFIER IS "DOUBTFUL CASES", ENTER # OF VISITS ALLOWED
  1. DC I REC=22&$D(^AUPNPAT(DFN,34,22,0)) D
  1.  . S DIE="^AUPNPAT("
  1.  . S DA=DFN
  1.  . S DR=.26
  1.  . D ^DIE
  1.  . I $P($G(^AUPNPAT(DFN,0)),U,26)="" G DC
  1.  ;IF MODIFIER "DOUBTFUL CASES WAS DELETED, DELETE # VISITS ALLOWED
  1.  I '$D(^AUPNPAT(DFN,34,22,0))&($P($G(^AUPNPAT(DFN,0)),U,26)'="") S $P(^AUPNPAT(DFN,0),U,26)=""
  1.  Q
  1. CHSTAT ;STATUS OF MEDICAL RECORD
  1.  N DIC,DIE,DR,DA
  1.  S DA(1)=DFN
  1.  S DA=DUZ(2)
  1.  S DIE="^AUPNPAT("_DA(1)_",41,"
  1.  S DR=".04"
  1.  D ^DIE
  1.  Q
  1. PRIVA ;PRIVACY ACT
  1.  N DIC,DIE,DR,DA
  1.  S DIE="^AUPNPAT("
  1.  S DR=.27
  1.  S DA=DFN
  1.  D ^DIE
  1.  Q
  1. LDOC ;ASK ADD OR EDIT LEGAL DOCS ENTRY
  1.  D LDOC^AGLDOC
  1.  Q
  1. MCRMSG ;IMPORTANT MESSAGE FORM MEDICARE DATE
  1.  I '$D(^AUPNMCR(DFN,0)) W !,"THIS PATIENT HAS NO MEDICARE COVERAGE" H 2
  1.  Q:'$D(^AUPNMCR(DFN,0))
  1.  N DIC,DIE,DA,DR,DA
  1.  S DIE="^AUPNMCR("
  1.  S DR="1201;"
  1.  S DR(1,9000003)="1201;",DR(2,9000003.1201)=".01"
  1.  S DA=DFN
  1.  D ^DIE
  1.  Q
  1. ROI ;RELEASE OF INFORMATION
  1.  N DIC,DIE,DR,DA
  1.  S DIE="^AUPNPAT("
  1.  S DR="3601;"
  1.  S DR(1,9000001)="3601;",DR(2,9000001.03601)=".01"
  1.  S DA=DFN
  1.  D ^DIE
  1.  ;
  1.  ;Force entry if required
  1.  I $G(Y)="",$O(^AUPNPAT(DFN,36,"B",""))="",$$RQROI^AGEDERR4(DUZ(2)) W "?? Required" G ROI
  1.  Q
  1. AOB ;ASSIGNMENT OF BENEFITS
  1.  N DIE,DR,X,Y,DIR,REC,DEF
  1.  S DIC(0)="AELMQZ"
  1.  S DA(1)=DFN
  1.  S DIC="^AUPNPAT("_DA(1)_",71,"
  1.  S DEF=$O(^AUPNPAT(DFN,71,"B",""),-1) S:DEF]"" DIC("B")=$$FMTE^DILIBF(DEF,"5U")
  1.  D ^DIC S REC=+Y
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  ;
  1.  ;Force entry if required
  1.  I $O(^AUPNPAT(DFN,71,"B",""))="",$$RQAOB^AGEDERR4(DUZ(2)) W "??  Required" G AOB
  1.  ;
  1.  Q:Y=-1
  1.  ;
  1.  S DIE=DIC
  1.  S DA=REC
  1.  S DR=".01"
  1.  D ^DIE
  1.  Q:$D(Y)
  1.  ;
  1.  ;Force entry if last entry deleted during edit
  1.  I $O(^AUPNPAT(DFN,71,"B",""))="",$$RQAOB^AGEDERR4(DUZ(2)) G AOB
  1.  ;
  1.  ;AG*7.1*8 - Plug AOB into ROI
  1.  I AGOPT(25)="Y" D
  1.  . N AOB,ROI,AGAOB,DA,ERROR,DIC,X,Y
  1.  . ;
  1.  . ;Pull ROI - quit if populated
  1.  . S ROI=$O(^AUPNPAT(DFN,36,"B",""),-1) Q:ROI]""  ;Pull ROI
  1.  . ;
  1.  . ;Plug in AOB
  1.  . S AOB=$O(^AUPNPAT(DFN,71,"B",""),-1) Q:AOB=""  ;Pull AOB
  1.  . ;
  1.  . S DA(1)=DFN
  1.  . S DIC="^AUPNPAT("_DFN_",36,"
  1.  . S DIC(0)="L"
  1.  . S X=AOB
  1.  . D ^DIC
  1.  ;
  1.  Q
  1. NPP ;EP - WAS NPP RECEIVED
  1.  N DIC,DIE,DR,DA,DLAYGO
  1.  K AG("STAMP")
  1.  S DIC="^AUPNNPP("
  1.  S DIC(0)="L"
  1.  S DLAYGO=9000038
  1.  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;.03;.06///^S X=AG(""STAMP"");.07////^S X=DUZ"
  1.  D ^DIE
  1.  I $P($G(^AUPNNPP(DA,0)),U,2)="" W !,"This is a mandatory HIPAA related field and must be answered." H 2 G NPP
  1.  Q
  1. ACK ;EP - ACKNOWLEDGEMENT AND REASON
  1.  D NPPCHK
  1.  I AG("NPPCHK")'=DFN&($D(AG("NPPADD"))) Q
  1.  I AG("NPPCHK")'=DFN W !,"Please answer question # 8 first." H 3 G DRAW
  1.  N DIC,DIE,DR,DA
  1.  S DIE="^AUPNNPP("
  1.  S DA=DFN
  1.  S DR=.04
  1.  D ^DIE
  1.  I $P($G(^AUPNNPP(DA,0)),U,4)="" W !,"This is another mandatory HIPAA related field and must be answered." H 2 G ACK
  1.  I $P($G(^AUPNNPP(DFN,0)),U,4)="N"  D
  1.  . S DR=.05
  1.  . D ^DIE
  1.  I $P($G(^AUPNNPP(DFN,0)),U,4)="Y"  D
  1.  . S DR=".05///@"
  1.  . D ^DIE
  1.  K AG("NPPCHK")
  1.  Q
  1. NPPCHK ;LOOK FOR EXISTANCE OF AUPNNPP RECORD
  1.  K AG("NPPCHK")
  1.  S AG("NPPCHK")=$O(^AUPNNPP("B",DFN,""))
  1.  Q
  1. RHI ;EP - RESTRICTED HEALTH INFORMATION
  1.  D RHICHK^AGED11B
  1.  I AG("RHICHK")>0 D EDITRHI^AGED11B Q
  1.  I AG("RHICHK")<1 D ADDRHI^AGED11B Q
  1.  Q
  1. ADVDIR(DAX) ;DISP ADVANCE DIRECTIVE
  1.  K AG("ADVDIR")  ;KILL DEFAULT VARIABLE
  1.  S DAX=","_DAX_","
  1.  D LIST^DIC(9000040.11,DAX,".02;.03;.04",,"*",,,,,,"ADVDIR","ADVDIRER")
  1.  I $D(ADVDIRER) K ADVDIRER Q  ;CAN'T FIND ENTRY FOR DA PASSED
  1.  I $P(ADVDIR("DILIST",0),U)=0 Q  ;DID NOT FIND ANY ENTRIES
  1.  S ADVLAST=$P(ADVDIR("DILIST",0),U)
  1.  W ADVDIR("DILIST","ID",ADVLAST,.02)
  1.  W ?40,"DATE: ",ADVDIR("DILIST",1,ADVLAST)
  1.  I ADVDIR("DILIST","ID",ADVLAST,.02)="NO" W !?3,"REASON: ",ADVDIR("DILIST","ID",ADVLAST,.04)
  1.  E  I ADVDIR("DILIST","ID",ADVLAST,.03)'="" W !?3,"TYPE:",ADVDIR("DILIST","ID",ADVLAST,.03)
  1.  S AG("ADVDIR")=ADVDIR("DILIST","ID",ADVLAST,.02)
  1.  K ADVDIR
  1.  Q
  1. ADVDIRED ;ADD/EDIT AN ADVANCE DIRECTIVE
  1.  I $D(AG("ADVDIR")) D EDADVDIR  ;EDIT EXISTING ENTRY
  1.  E  D ADADVDIR   ;NO ENTRY YET ADD IT
  1.  Q
  1. ADADVDIR ;ADD ADVANCE DIRECTIVE
  1.  N DIC,DIE,DR,DA
  1.  S DIC="^AUPNADVD("
  1.  S DIC(0)="L"
  1.  S DLAYGO=9000040
  1.  S X="`"_DFN
  1.  D ^DIC
  1.  Q:+Y<0
  1.  D EDADVDIR
  1.  Q
  1. EDADVDIR ;EDIT EXISTING ADVANCE DIRECTIVE
  1.  N DIC,DIE,DR,DA
  1.  S DA=DFN
  1.  S (DIE,DIC)="^AUPNADVD("
  1.  S DR="1101"
  1.  ;IF ADVANCE DIRECTIVE=NO ASK ONLY REASON
  1.  ;IF ADVANCE DIRECTIVE=YES ASK ONLY TYPE
  1.  S DR(2,9000040.11)=".01;.02;S:X=""N"" Y=""@1"" S:X=""Y"" Y=.03 S:X="""" Y=""@5"";.03;.04///@;S Y=0;@1;.04;.03///@;S Y=0;@5;.03///@;.04///@;.01///@"
  1.  D ^DIE
  1.  ;IF NO ADVANCE DIRECTIVE YES OR NO THEN THERE SHOULD NOT BE A
  1.  ;REASON OR A TYPE OTHERWISE DELETE THE FIELD NOT NEEDED DEPENDING
  1.  ;ON IF ITS YES OR NO
  1.  ;
  1.  Q
  1. DRAW ;EP
  1.  D CHKRHI^AG
  1.  S AG("PG")=9
  1.  S ROUTID=$P($T(+1)," ")  ;SET ROUTINE ID FOR PROGRAMMER VIEW
  1.  D ^AGED
  1.  K ^UTILITY("DIQ1",$J)
  1.  F AG=1:1 D  Q:$G(AGSCRN)[("**END ITEMS**")
  1.  . S AGSCRN=$P($T(@1+AG),";;",2,13)
  1.  . Q:AGSCRN[("**END ITEMS**")
  1.  . S AGNEWLN=$P(AGSCRN,U,5)
  1.  . I AG'=1 D
  1.  .. I AGNEWLN'="" W @AGNEWLN,AG,".",?$P(AGSCRN,U,2),$P(AGSCRN,U)," :  "
  1.  .. E  W ?$P(AGSCRN,U,2),AG,".",$P(AGSCRN,U)," :  "
  1.  . ;I AG'=1&(AG'=2) D
  1.  . I AG'=1&(AG'=2)&(AG'=3) D  ;AG*7.1*1 IM18991
  1.  .. S DA=DFN
  1.  .. S DIC=$P(AGSCRN,U,3)
  1.  .. S DR=$P(AGSCRN,U,4)
  1.  .. Q:'DIC!('DR)  ;DISP ADDED TO CHECK FOR FILLER ITEMS IN TAG 1
  1.  .. ;SHOW LAST AOB
  1.  .. ;I AG=7 D
  1.  .. I AG=6 D
  1.  ... S AG("AOB")=$O(^AUPNPAT(DFN,71,"B",""),-1)
  1.  ... I $G(AG("AOB"))'="" W $E(AG("AOB"),4,5)_"/"_$E(AG("AOB"),6,7)_"/"_($E(AG("AOB"),1,3)+1700)
  1.  .. K AGRES
  1.  .. S TEMPDIC=DIC
  1.  .. S DIQ="AGRES",DIQ(0)="E" D EN^DIQ1
  1.  .. S DIC=TEMPDIC
  1.  .. W $G(AGRES(DIC,DA,DR,"E"))
  1.  .. K AGRES,TEMPDIC,AGRES
  1.  . I AG=1 D
  1.  .. W !,AG,".",?2,"REASON FOR "_$S(AGELSTS="C":"CHS & DIRECT",AGELSTS="I":"INELIGIBLE",AGELSTS="D":"DIRECT ONLY",AGELSTS="P":"PENDING",1:"NONE")_" : "
  1.  .. S (D1,CNT)=0,MOD="",MOVDT="",NUMCASES=""
  1.  .. F  S D1=$O(^AUPNPAT(DFN,34,D1)) Q:'D1  D
  1.  ... S MOD=$P($G(^AUPNELM(D1,0)),U)
  1.  ... I MOD["MOVED OUT OF CHSDA"  D
  1.  .... S MOVDT=$P($G(^AUPNPAT(DFN,49)),U)
  1.  .... I MOVDT="" S Y=""
  1.  .... E  S Y=$E(MOVDT,4,5)_"/"_$E(MOVDT,6,7)_"/"_($E(MOVDT,1,3)+1700)
  1.  ... I MOD["DOUBTFUL CASES"  D
  1.  .... S NUMCASES=$P($G(^AUPNPAT(DFN,0)),U,26)
  1.  ... W ?29,$E(MOD,1,45)
  1.  ... I MOD["MOVED OUT OF CHSDA" W ?51,"DATE MOVED : ",Y
  1.  ... I MOD["DOUBTFUL CASES" W ?63,"# VISITS : ",NUMCASES
  1.  ... S CNT=CNT+1
  1.  ... I CNT<$P($G(^AUPNPAT(DFN,34,0)),U,4) W !
  1.  . I AG=2  D
  1.  .. S DA(1)=DFN
  1.  .. S DA=DUZ(2)
  1.  .. S DIC="^AUPNPAT("_DA(1)_",41,"
  1.  .. I AG=2 S DR=".04"
  1.  .. K AGRES
  1.  .. S TEMPDIC=DIC
  1.  .. S DIQ="AGRES",DIQ(0)="E" D EN^DIQ1
  1.  .. S DIC=TEMPDIC
  1.  .. W $G(AGRES(9000001.41,DA,DR,"E"))
  1.  .. K AGRES,TEMPDIC,AGRES
  1.  . ;I AG=4 D
  1.  .  I AG=3 D
  1.  .. S D1=0 K DOCSTR,DOCPTR,DOC
  1.  .. F  S D1=$O(^AUPNPLDC("C",DFN,D1)) Q:'D1  D
  1.  ... S DOCSTR=$G(^AUPNPLDC(D1,0))
  1.  ... S DOCPTR=$P(DOCSTR,U,3)
  1.  ... I DOCPTR'="",$D(^AUPNELM(DOCPTR,0)) S DOC=$P($G(^AUPNELM(DOCPTR,0)),U)
  1.  .. I $D(DOC) W DOC
  1.  . ;I AG=5 D ADVDIR(DFN)
  1.  . I AG=4 D ADVDIR(DFN)
  1.  . ;I AG=6 D
  1.  .  I AG=5 D
  1.  .. S AG("ROI")=$O(^AUPNPAT(DFN,36,"B",""),-1)
  1.  .. I $G(AG("ROI"))'="" W $E(AG("ROI"),4,5)_"/"_$E(AG("ROI"),6,7)_"/"_($E(AG("ROI"),1,3)+1700)
  1.  . ;I AG=1!(AG=4)!(AG=5)!(AG=7) W !,AGLINE("-")
  1.  . I AG=1!(AG=4)!(AG=6) W !,AGLINE("-")
  1.  . ;I AG=8&($D(^AUPNNPP(DFN,0))) D
  1.  . I AG=7&($D(^AUPNNPP(DFN,0))) D
  1.  .. S NPPDT=$P($G(^AUPNNPP(DFN,0)),U,3)
  1.  .. Q:NPPDT=""
  1.  .. S Y=$E(NPPDT,4,5)_"/"_$E(NPPDT,6,7)_"/"_($E(NPPDT,1,3)+1700)
  1.  .. W ?63,"DATE:",Y
  1.  . ;I AG=9&($P($G(^AUPNNPP(DFN,0)),U,5)'="")  D
  1.  . I AG=8&($P($G(^AUPNNPP(DFN,0)),U,5)'="")  D
  1.  .. W !,?5,"REASON: ",$P($G(^AUPNNPP(DFN,0)),U,5)
  1.  . ;I AG=10 D FINDRHI^AGED11B
  1.  . I AG=9 D FINDRHI^AGED11B
  1.  S AG("N")=AG-1
  1.  W !,AGLINE("EQ")
  1.  K MYERRS,MYVARS
  1.  D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
  1.  S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="",MYVARS("SITE")=DUZ(2)
  1.  D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
  1.  W !,$G(AGLINE("-"))
  1.  D VERIF^AGUTILS
  1.  Q
  1.  ;FORMAT OF LINES BELOW
  1.  ;ITEM CAPTION^INDENT^FILE #/SUB FILE#^FIELD #^NEW LINE?
  1.  ;DATE PRIVACY ACT OBTAINED^3^9000001^.27^!  ;AG*7.1* REMOVED PER Cancellation of IHS 819 & 820
  1. 1 ;
  1.  ;;REASON FOR^1^9000001.34^.01^!
  1.  ;;STATUS OF MEDICAL RECORD^3^9000001.41^.04^!
  1.  ;;OTHER LEGAL DOCUMENTS^3^9000034^.03^!
  1.  ;;ADVANCE DIRECTIVES^3^^^!
  1.  ;;REL OF INFORMATION^3^9000001.03601^.01^
  1.  ;;ASSIGNMENT OF BENEFITS^40^9000001^7101^^
  1.  ;;NOTICE OF PRIVACY PRACTICES (NPP) REC'D BY PATIENT^1^9000038^.02^!
  1.  ;;ACKNOWLEDGEMENT OF RECEIPT OF NPP SIGNED^1^9000038^.04^!
  1.  ;;RESTRICTED HEALTH INFORMATION^1^9000039^.03^!
  1.  ;;**END ITEMS**