AMHGEVF ; IHS/CMI/MAW - AMH GUI Visit Form Data Edits (frmVisitDataEntry) 2/13/2009 8:54:11 AM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,6,8**;JUN 02, 2010;Build 7
;
;
;
Q
;
ADDPOV(PI,P,R,PN) ;EP -- add a pov
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
S APCDOVRR=1
S AMHIENS="+1,"
S AMHFDA(9002011.01,AMHIENS,.01)=PI
S AMHFDA(9002011.01,AMHIENS,.02)=P
S AMHFDA(9002011.01,AMHIENS,.03)=R
S AMHFDA(9002011.01,AMHIENS,.04)=PN
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add POV"
S AMHPIEN=$G(AMHIENS(1))
Q
;
EDITPOV(REC,PN) ;EP -- edit a pov
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
S APCDOVRR=1
S AMHIENS=REC_","
S AMHFDA(9002011.01,AMHIENS,.04)=PN
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Edit POV"
I '$D(AMHERRR(1)) S AMHPIEN=REC
Q
;
DELPOV(REC,A2) ;EP -- check to see if any POV records were deleted during edit
N ADA,R,A
S R="~"
S ADA=0 F S ADA=$O(A2(ADA)) Q:'ADA D
. N A2IEN
. S A2IEN=$P(A2(ADA),R)
. S A(A2IEN)=A2IEN
N IEN
S IEN=0 F S IEN=$O(^AMHRPRO("AD",REC,IEN)) Q:'IEN D
. N POVI
. S POVI=$P(^AMHRPRO(IEN,0),U)
. I '$G(A(POVI)) D
.. S DIK="^AMHRPRO(",DA=IEN D ^DIK
Q
;
ADDAXIS4(PI,P,R,PN) ;EP -- add axis 4
N AMHFDA,AMHIENS,AMHERRR,AMHAIEN
S AMHIENS="+2,"_R_","
S AMHFDA(9002011.06101,AMHIENS,.01)=PI
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Axis IV"
I '$D(AMHERRR) S AMHAIEN=$G(AMHIENS(1))
Q
;
EDAXIS4(REC,A4) ;EP -- check to see if any axis 4 records were deleted during edit
D CLNA4(REC)
N ADA,R,A
S R="~"
S ADA=0 F S ADA=$O(A4(ADA)) Q:'ADA D
. N A4IEN
. S A4IEN=$P(A4(ADA),R)
. S A(A4IEN)=A4IEN
N IEN
S IEN=0 F S IEN=$O(^AMHREC(REC,61,IEN)) Q:'IEN D
. N AXIS4
. S AXIS4=$P(^AMHREC(REC,61,IEN,0),U)
. I '$G(A(AXIS4)) D
.. S DA(1)=REC,DA=IEN,DIK="^AMHREC("_DA(1)_",61," D ^DIK
Q
;
CLNA4(RC) ;EP -- clean axis 4 and repopulate
N IEN
S IEN=0 F S IEN=$O(^AMHREC(RC,61,IEN)) Q:'IEN D
. S DA(1)=RC,DA=IEN,DIK="^AMHREC("_DA(1)_",61," D ^DIK
Q
;
MODV(AMHIEN,DM,REC,PP,PRO,CLN,TOC,ARR,EDT,LOC,AW,COM,P,GN,TIG,ATG) ;EP -- add/update MHSS RECORD entry
N AMHFDA,AMHIENS,AMHERRR
I DM="E",REC="" S DM="A"
S AMHIENS=$S(DM="A":"+1,",1:REC_",")
S AMHFDA(9002011,AMHIENS,.01)=EDT
S AMHFDA(9002011,AMHIENS,.02)=PRO
S AMHFDA(9002011,AMHIENS,1117)=$$HL^AMHUTIL2($E(PRO)) ;IHS/CMI/LAB - PATCH 8 HOSP LOC
S AMHFDA(9002011,AMHIENS,.25)=CLN
S AMHFDA(9002011,AMHIENS,.07)=TOC
S AMHFDA(9002011,AMHIENS,.04)=LOC
S AMHFDA(9002011,AMHIENS,.11)=AW
S AMHFDA(9002011,AMHIENS,.05)=COM
S AMHFDA(9002011,AMHIENS,.19)=DUZ
S AMHFDA(9002011,AMHIENS,.33)="R"
I $G(GN)]"" D
. S AMHFDA(9002011,AMHIENS,.12)=$G(ATG) ;activity time/pts
. S AMHFDA(9002011,AMHIENS,.34)=1
. S AMHFDA(9002011,AMHIENS,1109)=GN
. S AMHFDA(9002011,AMHIENS,1104)=TIG
I DM="A" D Q
. ;S AMHFDA(9002011,AMHIENS,.01)=EDT
. S AMHFDA(9002011,AMHIENS,.03)=DT
. S AMHFDA(9002011,AMHIENS,.08)=P
. ;S AMHFDA(9002011,AMHIENS,.17)="A"
. S AMHFDA(9002011,AMHIENS,.19)=DUZ
. S AMHFDA(9002011,AMHIENS,.22)="A"
. S AMHFDA(9002011,AMHIENS,1111)=1
. S AMHFDA(9002011.5101,"+2,"_AMHIENS,.01)=$$NOW^XLFDT
. S AMHFDA(9002011.5101,"+2,"_AMHIENS,.02)=DUZ
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Add Visit"
. S AMHIEN=+$G(AMHIENS(1))
. D MODPRV(PP,DM,AMHIEN,P,"P")
I DM="E" D Q
. S AMHIENS(1)=REC
. ;S AMHFDA(9002011,AMHIENS,.17)="E"
. S AMHFDA(9002011,AMHIENS,.21)=DT
. S AMHFDA(9002011,AMHIENS,.22)="M"
. S AMHFDA(9002011,AMHIENS,.28)=DUZ
. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Edit Visit"
. S AMHIEN=REC
. D MODPRV(PP,DM,AMHIEN,P,"P")
. D VAUD(REC) ;update the audit log
Q
;
MODPRV(P,D,R,PAT,TYP) ;EP -- modify the provider based on data mode
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
;Q:$$FNDPRV^AMHGU(R,TYP,P)
I (D="A")!(D="E") D
. Q:$$FNDPRV^AMHGU(R,TYP,P)
. S AMHIENS="+1,"
. S AMHFDA(9002011.02,AMHIENS,.01)=P
. S AMHFDA(9002011.02,AMHIENS,.02)=PAT
. S AMHFDA(9002011.02,AMHIENS,.03)=R
. S AMHFDA(9002011.02,AMHIENS,.04)=TYP
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Add "_$G(TYP)_" Provider"
. S AMHPIEN=$G(AMHIENS(1))
;ihs/cmi/maw v4.0p3 changing above call to A or E
;I D="E" D ;v4.0p2 ihs/cmi/maw added
;. S AMHIENS=$$FNDPRV^AMHGU(R,TYP,P)
;. S AMHPIEN=AMHIENS
Q
;
DELPRV(REC,PRV,TYP) ;EP -- delete a provider
N ADA,R,P
S R="~"
S ADA=0 F S ADA=$O(PRV(ADA)) Q:'ADA D
. N PRVIEN
. S PRVIEN=$P(PRV(ADA),R)
. S P(PRVIEN)=PRVIEN
N IEN
S IEN=0 F S IEN=$O(^AMHRPROV("AD",REC,IEN)) Q:'IEN D
. N PRVI
. S PRVI=$P(^AMHRPROV(IEN,0),U)
. S PTYP=$P(^AMHRPROV(IEN,0),U,4)
. I '$G(P(PRVI)) D
.. Q:PTYP'=TYP
.. S DIK="^AMHRPROV(",DA=IEN D ^DIK
Q
;
VAUD(RC) ;EP -- update the audit log
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=""
S AMHFDA(9002011,RC_",",.21)=DT
S AMHFDA(9002011,RC_",",.28)=DUZ
S AMHFDA(9002011.5101,"+2,"_RC_",",.01)=$$NOW^XLFDT
S AMHFDA(9002011.5101,"+2,"_RC_",",.02)=DUZ
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
Q
;
ACT(AMHIEN,DM,REC,ACT,VF,AT,IU,LSS,NS,P) ;EP -- file activity
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=REC_","
S AMHFDA(9002011,AMHIENS,.06)=ACT
S AMHFDA(9002011,AMHIENS,.27)=VF
S AMHFDA(9002011,AMHIENS,.12)=AT
S AMHFDA(9002011,AMHIENS,.15)=IU
S AMHFDA(9002011,AMHIENS,.31)=LSS
S AMHFDA(9002011,AMHIENS,.09)=NS
S AMHIENS(1)=REC
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Activity"
S AMHIEN=REC
Q
;
MODCPT(CI,Q,M1,M2,P,R) ;EP -- add a cpt
Q:$$FNDCPT^AMHGU(R,CI)
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
S AMHIENS="+1,"
S AMHFDA(9002011.04,AMHIENS,.01)=CI
S AMHFDA(9002011.04,AMHIENS,.02)=P
S AMHFDA(9002011.04,AMHIENS,.03)=R
S AMHFDA(9002011.04,AMHIENS,.16)=Q
S AMHFDA(9002011.04,AMHIENS,.08)=M1
S AMHFDA(9002011.04,AMHIENS,.09)=M2
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Activity CPT"
S AMHPIEN=$G(AMHIENS(1))
Q
;
DELCPT(REC,CP) ;EP -- check to see if any cpt records were deleted during edit
N ADA,R,C
S R="~"
S ADA=0 F S ADA=$O(CP(ADA)) Q:'ADA D
. N CPIEN
. S CPIEN=$P(CP(ADA),R)
. S C(CPIEN)=CPIEN
N IEN
S IEN=0 F S IEN=$O(^AMHRPROC("AD",REC,IEN)) Q:'IEN D
. N CPTI
. S CPTI=$P(^AMHRPROC(IEN,0),U)
. I '$G(C(CPTI)) D
.. S DIK="^AMHRPROC(",DA=IEN D ^DIK
Q
;
CCPD(D,RC,CC,PD,PLN,P) ;EP -- file the chief complaint
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
S AMHFDA(9002011,AMHIENS,2101)=CC
S AMHFDA(9002011,AMHIENS,.17)=PD
S AMHFDA(9002011,AMHIENS,.18)=PLN
D FILE^DIE("","AMHFDA","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Update Chief Complaint"
Q
;
PN(D,RC,PN,P) ;EP -- file the progress notes
;Q:$G(PN)=""
;D CLNWP^AMHGUA(9002011,31,RC)
N AMHWP
D ARRAYT^AMHGU(.AMHWP,PN) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011,AMHIENS,3101,.AMHWP)
Q
;
CMT(D,RC,CMT,P) ;EP -- file the comment next appointment
;Q:$G(CMT)=""
N AMHWP
D ARRAYT^AMHGU(.AMHWP,CMT) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011,AMHIENS,8101,.AMHWP)
Q
;
RX(D,RC,RX,P) ;EP -- file the rx entry
;Q:$G(RX)=""
N AMHWP
D ARRAYT^AMHGU(.AMHWP,RX) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011,AMHIENS,4101,.AMHWP)
Q
;
MODEDU(D,RC,P,ED,TS,L,CM,CP,ST,G,I,REA,PRV) ;EP -- file the education topics
N EDREC
S EDREC=$$FNDEDU^AMHGU(RC,ED)
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=$S($G(EDREC):EDREC_",",1:"+1,")
S AMHFDA(9002011.05,AMHIENS,.04)=PRV
S AMHFDA(9002011.05,AMHIENS,.05)=I
S AMHFDA(9002011.05,AMHIENS,.06)=TS
S AMHFDA(9002011.05,AMHIENS,.07)=CP
S AMHFDA(9002011.05,AMHIENS,.08)=L
S AMHFDA(9002011.05,AMHIENS,.09)=G
S AMHFDA(9002011.05,AMHIENS,.11)=ST
S AMHFDA(9002011.05,AMHIENS,1101)=CM
S AMHFDA(9002011.05,AMHIENS,1102)=REA
I $G(EDREC),+$G(TS)=0 D Q
. S DIK="^AMHREDU(",DA=EDREC D ^DIK
I $G(EDREC) D Q
. S AMHIENS=EDREC_","
. D FILE^DIE("K","AMHFDA","AMHERRR")
. I $D(AMHERRR) S AMHER="0~Edit Education Topic"
S AMHFDA(9002011.05,AMHIENS,.01)=ED
S AMHFDA(9002011.05,AMHIENS,.02)=P
S AMHFDA(9002011.05,AMHIENS,.03)=RC
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Education Topic"
Q
;
DELEDU(REC,ED) ;EP -- delete an education topic if removed from the client side
N ADA,R,E
S R="~"
S ADA=0 F S ADA=$O(ED(ADA)) Q:'ADA D
. N EDIEN,EDE
. S EDE=$P(ED(ADA),R)
. S EDIEN=$O(^AUTTEDT("B",EDE,0))
. S E(EDIEN)=EDIEN
N IEN
S IEN=0 F S IEN=$O(^AMHREDU("AD",REC,IEN)) Q:'IEN D
. N EDUI
. S EDUI=$P(^AMHREDU(IEN,0),U)
. I '$G(E(EDUI)) D
.. S DIK="^AMHREDU(",DA=IEN D ^DIK
Q
;
MODHF(D,RC,P,HF,LS,Q,CM) ;EP -- file the health factors
N HFREC
S HFREC=$$FNDHF^AMHGU(RC,HF)
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=$S($G(HFREC):HFREC_",",1:"+1,")
S AMHFDA(9002011.08,AMHIENS,.04)=LS
S AMHFDA(9002011.08,AMHIENS,.05)=DUZ
S AMHFDA(9002011.08,AMHIENS,.06)=QTY
S AMHFDA(9002011.08,AMHIENS,81101)=CMT
I $G(HFREC) D Q
. S AMHIENS=HFREC_","
. D FILE^DIE("K","AMHFDA","AMHERRR")
. I $D(AMHERRR) S AMHER="0~Edit Health Factor"
S AMHFDA(9002011.08,AMHIENS,.01)=HF
S AMHFDA(9002011.08,AMHIENS,.02)=P
S AMHFDA(9002011.08,AMHIENS,.03)=RC
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Health Factor"
Q
;
DELHF(REC,HF) ;EP -- delete a health factor if removed from the client side
N ADA,R,H
S R="~"
S ADA=0 F S ADA=$O(HF(ADA)) Q:'ADA D
. N HFIEN,HFE
. S HFE=$P(HF(ADA),R)
. S HFIEN=$O(^AUTTHF("B",HFE,0))
. S H(HFIEN)=HFIEN
N IEN
S IEN=0 F S IEN=$O(^AMHRHF("AD",REC,IEN)) Q:'IEN D
. N HFI
. S HFI=$P(^AMHRHF(IEN,0),U)
. I '$G(H(HFI)) D
.. S DIK="^AMHRHF(",DA=IEN D ^DIK
Q
;
SCREEN(D,RC,P,PP,A,AC,DP,DPC,IP,IPC,APRV,DPRV,IPRV,S,SC,SPRV) ;EP -- file screening
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
;I $G(IP)]"" D
S AMHFDA(9002011,AMHIENS,1401)=IP
S AMHFDA(9002011,AMHIENS,1402)=IPRV
;I $G(A)]"" D
S AMHFDA(9002011,AMHIENS,1403)=A
S AMHFDA(9002011,AMHIENS,1404)=APRV
;I $G(DP)]"" D
S AMHFDA(9002011,AMHIENS,1405)=DP
S AMHFDA(9002011,AMHIENS,1406)=DPRV
S AMHFDA(9002011,AMHIENS,1601)=AC
S AMHFDA(9002011,AMHIENS,1701)=DPC
S AMHFDA(9002011,AMHIENS,1501)=IPC
S AMHFDA(9002011,AMHIENS,1407)=S
S AMHFDA(9002011,AMHIENS,1408)=SPRV
S AMHFDA(9002011,AMHIENS,1901)=SC
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Edit Screening"
Q
;
MODMSR(D,RC,P,MS,V,PR) ;EP -- file the measurements
N MSRREC
S MSRREC=$$FNDMSR^AMHGU(RC,MS)
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=$S($G(MSRREC):MSRREC_",",1:"+1,")
S AMHFDA(9002011.12,AMHIENS,.04)=V
S AMHFDA(9002011.12,AMHIENS,1204)=PR
I $G(MSRREC) D Q
. S AMHIENS=MSRREC_","
. D FILE^DIE("K","AMHFDA","AMHERRR")
. I $D(AMHERRR) S AMHER="0~Edit Measurement"
S AMHFDA(9002011.12,AMHIENS,.01)=MS
S AMHFDA(9002011.12,AMHIENS,.02)=P
S AMHFDA(9002011.12,AMHIENS,.03)=RC
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Measurement"
Q
;
DELMSR(REC,MSR) ;EP -- delete a measurement if removed from the client side
N ADA,R,M
S R="~"
S ADA=0 F S ADA=$O(MSR(ADA)) Q:'ADA D
. N MSRIEN,MSRE
. S MSRE=$P(MSR(ADA),R)
. S MSRIEN=$O(^AUTTMSR("B",MSRE,0))
. S M(MSRIEN)=MSRIEN
N IEN
S IEN=0 F S IEN=$O(^AMHRMSR("AD",REC,IEN)) Q:'IEN D
. N MSRI
. S MSRI=$P(^AMHRMSR(IEN,0),U)
. I '$G(M(MSRI)) D
.. S DIK="^AMHRMSR(",DA=IEN D ^DIK
Q
;
ASS(D,RC,A,P,IT,PP,PRG,EDT) ;EP -- file assessment
;Q:$G(A)=""
I $G(D)="A",$G(A)="" Q
;I '$O(^AMHRINTK("AD",RC,0)),$G(A)="" Q
N AMHWP
D ARRAYT^AMHGU(.AMHWP,A) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR,AMHIT
S AMHIENS=""
;S AMHIENS(1)=P
I $G(IT) D
. S AMHIENS=IT_","
. S AMHIT=IT
. S AMHFDA(9002011.13,AMHIENS,.06)=PP
. S AMHFDA(9002011.13,AMHIENS,.07)=DT
. D FILE^DIE("K","AMHFDA","AMHERRR(1)")
. Q:$O(^AMHRINTK(IT,11,RC,"B",0))
. N AMHFDA,AMHIENS,AMHERRR
. S AMHIENS="+2,"_IT_","
. S AMHFDA(9002011.1311,AMHIENS,.01)=RC
. I '$D(^AMHRINTK(IT,11)) S AMHFDA(9002011.1311,AMHIENS,.02)=1
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Edit Assessment"
I '$G(IT) D
. S AMHFDA(9002011.13,"+1,",.01)=EDT
. S AMHFDA(9002011.13,"+1,",.02)=P
. S AMHFDA(9002011.13,"+1,",.03)=RC
. S AMHFDA(9002011.13,"+1,",.04)=PP
. S AMHFDA(9002011.13,"+1,",.05)=PRG
. S AMHFDA(9002011.13,"+1,",.06)=PP
. S AMHFDA(9002011.13,"+1,",.07)=DT
. S AMHFDA(9002011.13,"+1,",.09)="I"
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
. I $D(AMHERRR) S AMHER="0~Add Assessment" Q
. S AMHIT=$G(AMHIENS(1))
. N AMHVFDA,AMHVIENS,AMHVERR,AMHVRS
. S AMHVIENS="+2,+1,"
. S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.01)=RC
. S AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.02)=1
. D UPDATE^DIE("","AMHVFDA","AMHVIENS","AMHVERR")
. S AMHVRS=$G(AMHVIENS(2))
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=AMHIT_","
D WP^AMHGU(.AMHERRR,9002011.13,AMHIENS,4100,.AMHWP)
Q
;
CD(D,RC,P,CDC,CDT,TOC,DRT,DIA) ;EP -- file CD data
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
S AMHFDA(9002011,AMHIENS,1101)=CDC
S AMHFDA(9002011,AMHIENS,1105)=CDT
S AMHFDA(9002011,AMHIENS,.32)=TOC
S AMHFDA(9002011,AMHIENS,1102)=DRT
S AMHFDA(9002011,AMHIENS,1103)=DIA
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Edit CD Data"
Q
;
AMHGEVF ; IHS/CMI/MAW - AMH GUI Visit Form Data Edits (frmVisitDataEntry) 2/13/2009 8:54:11 AM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,6,8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
+4 ;
+5 QUIT
+6 ;
ADDPOV(PI,P,R,PN) ;EP -- add a pov
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+2 SET APCDOVRR=1
+3 SET AMHIENS="+1,"
+4 SET AMHFDA(9002011.01,AMHIENS,.01)=PI
+5 SET AMHFDA(9002011.01,AMHIENS,.02)=P
+6 SET AMHFDA(9002011.01,AMHIENS,.03)=R
+7 SET AMHFDA(9002011.01,AMHIENS,.04)=PN
+8 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+9 IF $DATA(AMHERRR)
SET AMHER="0~Add POV"
+10 SET AMHPIEN=$GET(AMHIENS(1))
+11 QUIT
+12 ;
EDITPOV(REC,PN) ;EP -- edit a pov
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+2 SET APCDOVRR=1
+3 SET AMHIENS=REC_","
+4 SET AMHFDA(9002011.01,AMHIENS,.04)=PN
+5 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+6 IF $DATA(AMHERRR)
SET AMHER="0~Edit POV"
+7 IF '$DATA(AMHERRR(1))
SET AMHPIEN=REC
+8 QUIT
+9 ;
DELPOV(REC,A2) ;EP -- check to see if any POV records were deleted during edit
+1 NEW ADA,R,A
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(A2(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW A2IEN
+5 SET A2IEN=$PIECE(A2(ADA),R)
+6 SET A(A2IEN)=A2IEN
End DoDot:1
+7 NEW IEN
+8 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRPRO("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW POVI
+10 SET POVI=$PIECE(^AMHRPRO(IEN,0),U)
+11 IF '$GET(A(POVI))
Begin DoDot:2
+12 SET DIK="^AMHRPRO("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
ADDAXIS4(PI,P,R,PN) ;EP -- add axis 4
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHAIEN
+2 SET AMHIENS="+2,"_R_","
+3 SET AMHFDA(9002011.06101,AMHIENS,.01)=PI
+4 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+5 IF $DATA(AMHERRR)
SET AMHER="0~Add Axis IV"
+6 IF '$DATA(AMHERRR)
SET AMHAIEN=$GET(AMHIENS(1))
+7 QUIT
+8 ;
EDAXIS4(REC,A4) ;EP -- check to see if any axis 4 records were deleted during edit
+1 DO CLNA4(REC)
+2 NEW ADA,R,A
+3 SET R="~"
+4 SET ADA=0
FOR
SET ADA=$ORDER(A4(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+5 NEW A4IEN
+6 SET A4IEN=$PIECE(A4(ADA),R)
+7 SET A(A4IEN)=A4IEN
End DoDot:1
+8 NEW IEN
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AMHREC(REC,61,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+10 NEW AXIS4
+11 SET AXIS4=$PIECE(^AMHREC(REC,61,IEN,0),U)
+12 IF '$GET(A(AXIS4))
Begin DoDot:2
+13 SET DA(1)=REC
SET DA=IEN
SET DIK="^AMHREC("_DA(1)_",61,"
DO ^DIK
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
CLNA4(RC) ;EP -- clean axis 4 and repopulate
+1 NEW IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^AMHREC(RC,61,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 SET DA(1)=RC
SET DA=IEN
SET DIK="^AMHREC("_DA(1)_",61,"
DO ^DIK
End DoDot:1
+4 QUIT
+5 ;
MODV(AMHIEN,DM,REC,PP,PRO,CLN,TOC,ARR,EDT,LOC,AW,COM,P,GN,TIG,ATG) ;EP -- add/update MHSS RECORD entry
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 IF DM="E"
IF REC=""
SET DM="A"
+3 SET AMHIENS=$SELECT(DM="A":"+1,",1:REC_",")
+4 SET AMHFDA(9002011,AMHIENS,.01)=EDT
+5 SET AMHFDA(9002011,AMHIENS,.02)=PRO
+6 ;IHS/CMI/LAB - PATCH 8 HOSP LOC
SET AMHFDA(9002011,AMHIENS,1117)=$$HL^AMHUTIL2($EXTRACT(PRO))
+7 SET AMHFDA(9002011,AMHIENS,.25)=CLN
+8 SET AMHFDA(9002011,AMHIENS,.07)=TOC
+9 SET AMHFDA(9002011,AMHIENS,.04)=LOC
+10 SET AMHFDA(9002011,AMHIENS,.11)=AW
+11 SET AMHFDA(9002011,AMHIENS,.05)=COM
+12 SET AMHFDA(9002011,AMHIENS,.19)=DUZ
+13 SET AMHFDA(9002011,AMHIENS,.33)="R"
+14 IF $GET(GN)]""
Begin DoDot:1
+15 ;activity time/pts
SET AMHFDA(9002011,AMHIENS,.12)=$GET(ATG)
+16 SET AMHFDA(9002011,AMHIENS,.34)=1
+17 SET AMHFDA(9002011,AMHIENS,1109)=GN
+18 SET AMHFDA(9002011,AMHIENS,1104)=TIG
End DoDot:1
+19 IF DM="A"
Begin DoDot:1
+20 ;S AMHFDA(9002011,AMHIENS,.01)=EDT
+21 SET AMHFDA(9002011,AMHIENS,.03)=DT
+22 SET AMHFDA(9002011,AMHIENS,.08)=P
+23 ;S AMHFDA(9002011,AMHIENS,.17)="A"
+24 SET AMHFDA(9002011,AMHIENS,.19)=DUZ
+25 SET AMHFDA(9002011,AMHIENS,.22)="A"
+26 SET AMHFDA(9002011,AMHIENS,1111)=1
+27 SET AMHFDA(9002011.5101,"+2,"_AMHIENS,.01)=$$NOW^XLFDT
+28 SET AMHFDA(9002011.5101,"+2,"_AMHIENS,.02)=DUZ
+29 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+30 IF $DATA(AMHERRR)
SET AMHER="0~Add Visit"
+31 SET AMHIEN=+$GET(AMHIENS(1))
+32 DO MODPRV(PP,DM,AMHIEN,P,"P")
End DoDot:1
QUIT
+33 IF DM="E"
Begin DoDot:1
+34 SET AMHIENS(1)=REC
+35 ;S AMHFDA(9002011,AMHIENS,.17)="E"
+36 SET AMHFDA(9002011,AMHIENS,.21)=DT
+37 SET AMHFDA(9002011,AMHIENS,.22)="M"
+38 SET AMHFDA(9002011,AMHIENS,.28)=DUZ
+39 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+40 IF $DATA(AMHERRR)
SET AMHER="0~Edit Visit"
+41 SET AMHIEN=REC
+42 DO MODPRV(PP,DM,AMHIEN,P,"P")
+43 ;update the audit log
DO VAUD(REC)
End DoDot:1
QUIT
+44 QUIT
+45 ;
MODPRV(P,D,R,PAT,TYP) ;EP -- modify the provider based on data mode
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+2 ;Q:$$FNDPRV^AMHGU(R,TYP,P)
+3 IF (D="A")!(D="E")
Begin DoDot:1
+4 IF $$FNDPRV^AMHGU(R,TYP,P)
QUIT
+5 SET AMHIENS="+1,"
+6 SET AMHFDA(9002011.02,AMHIENS,.01)=P
+7 SET AMHFDA(9002011.02,AMHIENS,.02)=PAT
+8 SET AMHFDA(9002011.02,AMHIENS,.03)=R
+9 SET AMHFDA(9002011.02,AMHIENS,.04)=TYP
+10 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+11 IF $DATA(AMHERRR)
SET AMHER="0~Add "_$GET(TYP)_" Provider"
+12 SET AMHPIEN=$GET(AMHIENS(1))
End DoDot:1
+13 ;ihs/cmi/maw v4.0p3 changing above call to A or E
+14 ;I D="E" D ;v4.0p2 ihs/cmi/maw added
+15 ;. S AMHIENS=$$FNDPRV^AMHGU(R,TYP,P)
+16 ;. S AMHPIEN=AMHIENS
+17 QUIT
+18 ;
DELPRV(REC,PRV,TYP) ;EP -- delete a provider
+1 NEW ADA,R,P
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(PRV(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW PRVIEN
+5 SET PRVIEN=$PIECE(PRV(ADA),R)
+6 SET P(PRVIEN)=PRVIEN
End DoDot:1
+7 NEW IEN
+8 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRPROV("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW PRVI
+10 SET PRVI=$PIECE(^AMHRPROV(IEN,0),U)
+11 SET PTYP=$PIECE(^AMHRPROV(IEN,0),U,4)
+12 IF '$GET(P(PRVI))
Begin DoDot:2
+13 IF PTYP'=TYP
QUIT
+14 SET DIK="^AMHRPROV("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
VAUD(RC) ;EP -- update the audit log
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=""
+3 SET AMHFDA(9002011,RC_",",.21)=DT
+4 SET AMHFDA(9002011,RC_",",.28)=DUZ
+5 SET AMHFDA(9002011.5101,"+2,"_RC_",",.01)=$$NOW^XLFDT
+6 SET AMHFDA(9002011.5101,"+2,"_RC_",",.02)=DUZ
+7 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+8 QUIT
+9 ;
ACT(AMHIEN,DM,REC,ACT,VF,AT,IU,LSS,NS,P) ;EP -- file activity
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=REC_","
+3 SET AMHFDA(9002011,AMHIENS,.06)=ACT
+4 SET AMHFDA(9002011,AMHIENS,.27)=VF
+5 SET AMHFDA(9002011,AMHIENS,.12)=AT
+6 SET AMHFDA(9002011,AMHIENS,.15)=IU
+7 SET AMHFDA(9002011,AMHIENS,.31)=LSS
+8 SET AMHFDA(9002011,AMHIENS,.09)=NS
+9 SET AMHIENS(1)=REC
+10 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+11 IF $DATA(AMHERRR)
SET AMHER="0~Add Activity"
+12 SET AMHIEN=REC
+13 QUIT
+14 ;
MODCPT(CI,Q,M1,M2,P,R) ;EP -- add a cpt
+1 IF $$FNDCPT^AMHGU(R,CI)
QUIT
+2 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+3 SET AMHIENS="+1,"
+4 SET AMHFDA(9002011.04,AMHIENS,.01)=CI
+5 SET AMHFDA(9002011.04,AMHIENS,.02)=P
+6 SET AMHFDA(9002011.04,AMHIENS,.03)=R
+7 SET AMHFDA(9002011.04,AMHIENS,.16)=Q
+8 SET AMHFDA(9002011.04,AMHIENS,.08)=M1
+9 SET AMHFDA(9002011.04,AMHIENS,.09)=M2
+10 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+11 IF $DATA(AMHERRR)
SET AMHER="0~Add Activity CPT"
+12 SET AMHPIEN=$GET(AMHIENS(1))
+13 QUIT
+14 ;
DELCPT(REC,CP) ;EP -- check to see if any cpt records were deleted during edit
+1 NEW ADA,R,C
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(CP(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW CPIEN
+5 SET CPIEN=$PIECE(CP(ADA),R)
+6 SET C(CPIEN)=CPIEN
End DoDot:1
+7 NEW IEN
+8 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRPROC("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW CPTI
+10 SET CPTI=$PIECE(^AMHRPROC(IEN,0),U)
+11 IF '$GET(C(CPTI))
Begin DoDot:2
+12 SET DIK="^AMHRPROC("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
CCPD(D,RC,CC,PD,PLN,P) ;EP -- file the chief complaint
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=RC_","
+3 SET AMHFDA(9002011,AMHIENS,2101)=CC
+4 SET AMHFDA(9002011,AMHIENS,.17)=PD
+5 SET AMHFDA(9002011,AMHIENS,.18)=PLN
+6 DO FILE^DIE("","AMHFDA","AMHERRR(1)")
+7 IF $DATA(AMHERRR)
SET AMHER="0~Update Chief Complaint"
+8 QUIT
+9 ;
PN(D,RC,PN,P) ;EP -- file the progress notes
+1 ;Q:$G(PN)=""
+2 ;D CLNWP^AMHGUA(9002011,31,RC)
+3 NEW AMHWP
+4 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,PN)
+5 NEW AMHFDA,AMHIENS,AMHERRR
+6 SET AMHIENS=RC_","
+7 DO WP^AMHGU(.AMHERRR,9002011,AMHIENS,3101,.AMHWP)
+8 QUIT
+9 ;
CMT(D,RC,CMT,P) ;EP -- file the comment next appointment
+1 ;Q:$G(CMT)=""
+2 NEW AMHWP
+3 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,CMT)
+4 NEW AMHFDA,AMHIENS,AMHERRR
+5 SET AMHIENS=RC_","
+6 DO WP^AMHGU(.AMHERRR,9002011,AMHIENS,8101,.AMHWP)
+7 QUIT
+8 ;
RX(D,RC,RX,P) ;EP -- file the rx entry
+1 ;Q:$G(RX)=""
+2 NEW AMHWP
+3 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,RX)
+4 NEW AMHFDA,AMHIENS,AMHERRR
+5 SET AMHIENS=RC_","
+6 DO WP^AMHGU(.AMHERRR,9002011,AMHIENS,4101,.AMHWP)
+7 QUIT
+8 ;
MODEDU(D,RC,P,ED,TS,L,CM,CP,ST,G,I,REA,PRV) ;EP -- file the education topics
+1 NEW EDREC
+2 SET EDREC=$$FNDEDU^AMHGU(RC,ED)
+3 NEW AMHFDA,AMHIENS,AMHERRR
+4 SET AMHIENS=$SELECT($GET(EDREC):EDREC_",",1:"+1,")
+5 SET AMHFDA(9002011.05,AMHIENS,.04)=PRV
+6 SET AMHFDA(9002011.05,AMHIENS,.05)=I
+7 SET AMHFDA(9002011.05,AMHIENS,.06)=TS
+8 SET AMHFDA(9002011.05,AMHIENS,.07)=CP
+9 SET AMHFDA(9002011.05,AMHIENS,.08)=L
+10 SET AMHFDA(9002011.05,AMHIENS,.09)=G
+11 SET AMHFDA(9002011.05,AMHIENS,.11)=ST
+12 SET AMHFDA(9002011.05,AMHIENS,1101)=CM
+13 SET AMHFDA(9002011.05,AMHIENS,1102)=REA
+14 IF $GET(EDREC)
IF +$GET(TS)=0
Begin DoDot:1
+15 SET DIK="^AMHREDU("
SET DA=EDREC
DO ^DIK
End DoDot:1
QUIT
+16 IF $GET(EDREC)
Begin DoDot:1
+17 SET AMHIENS=EDREC_","
+18 DO FILE^DIE("K","AMHFDA","AMHERRR")
+19 IF $DATA(AMHERRR)
SET AMHER="0~Edit Education Topic"
End DoDot:1
QUIT
+20 SET AMHFDA(9002011.05,AMHIENS,.01)=ED
+21 SET AMHFDA(9002011.05,AMHIENS,.02)=P
+22 SET AMHFDA(9002011.05,AMHIENS,.03)=RC
+23 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+24 IF $DATA(AMHERRR)
SET AMHER="0~Add Education Topic"
+25 QUIT
+26 ;
DELEDU(REC,ED) ;EP -- delete an education topic if removed from the client side
+1 NEW ADA,R,E
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(ED(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW EDIEN,EDE
+5 SET EDE=$PIECE(ED(ADA),R)
+6 SET EDIEN=$ORDER(^AUTTEDT("B",EDE,0))
+7 SET E(EDIEN)=EDIEN
End DoDot:1
+8 NEW IEN
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AMHREDU("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+10 NEW EDUI
+11 SET EDUI=$PIECE(^AMHREDU(IEN,0),U)
+12 IF '$GET(E(EDUI))
Begin DoDot:2
+13 SET DIK="^AMHREDU("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
MODHF(D,RC,P,HF,LS,Q,CM) ;EP -- file the health factors
+1 NEW HFREC
+2 SET HFREC=$$FNDHF^AMHGU(RC,HF)
+3 NEW AMHFDA,AMHIENS,AMHERRR
+4 SET AMHIENS=$SELECT($GET(HFREC):HFREC_",",1:"+1,")
+5 SET AMHFDA(9002011.08,AMHIENS,.04)=LS
+6 SET AMHFDA(9002011.08,AMHIENS,.05)=DUZ
+7 SET AMHFDA(9002011.08,AMHIENS,.06)=QTY
+8 SET AMHFDA(9002011.08,AMHIENS,81101)=CMT
+9 IF $GET(HFREC)
Begin DoDot:1
+10 SET AMHIENS=HFREC_","
+11 DO FILE^DIE("K","AMHFDA","AMHERRR")
+12 IF $DATA(AMHERRR)
SET AMHER="0~Edit Health Factor"
End DoDot:1
QUIT
+13 SET AMHFDA(9002011.08,AMHIENS,.01)=HF
+14 SET AMHFDA(9002011.08,AMHIENS,.02)=P
+15 SET AMHFDA(9002011.08,AMHIENS,.03)=RC
+16 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+17 IF $DATA(AMHERRR)
SET AMHER="0~Add Health Factor"
+18 QUIT
+19 ;
DELHF(REC,HF) ;EP -- delete a health factor if removed from the client side
+1 NEW ADA,R,H
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(HF(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW HFIEN,HFE
+5 SET HFE=$PIECE(HF(ADA),R)
+6 SET HFIEN=$ORDER(^AUTTHF("B",HFE,0))
+7 SET H(HFIEN)=HFIEN
End DoDot:1
+8 NEW IEN
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRHF("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+10 NEW HFI
+11 SET HFI=$PIECE(^AMHRHF(IEN,0),U)
+12 IF '$GET(H(HFI))
Begin DoDot:2
+13 SET DIK="^AMHRHF("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
SCREEN(D,RC,P,PP,A,AC,DP,DPC,IP,IPC,APRV,DPRV,IPRV,S,SC,SPRV) ;EP -- file screening
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=RC_","
+3 ;I $G(IP)]"" D
+4 SET AMHFDA(9002011,AMHIENS,1401)=IP
+5 SET AMHFDA(9002011,AMHIENS,1402)=IPRV
+6 ;I $G(A)]"" D
+7 SET AMHFDA(9002011,AMHIENS,1403)=A
+8 SET AMHFDA(9002011,AMHIENS,1404)=APRV
+9 ;I $G(DP)]"" D
+10 SET AMHFDA(9002011,AMHIENS,1405)=DP
+11 SET AMHFDA(9002011,AMHIENS,1406)=DPRV
+12 SET AMHFDA(9002011,AMHIENS,1601)=AC
+13 SET AMHFDA(9002011,AMHIENS,1701)=DPC
+14 SET AMHFDA(9002011,AMHIENS,1501)=IPC
+15 SET AMHFDA(9002011,AMHIENS,1407)=S
+16 SET AMHFDA(9002011,AMHIENS,1408)=SPRV
+17 SET AMHFDA(9002011,AMHIENS,1901)=SC
+18 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+19 IF $DATA(AMHERRR)
SET AMHER="0~Edit Screening"
+20 QUIT
+21 ;
MODMSR(D,RC,P,MS,V,PR) ;EP -- file the measurements
+1 NEW MSRREC
+2 SET MSRREC=$$FNDMSR^AMHGU(RC,MS)
+3 NEW AMHFDA,AMHIENS,AMHERRR
+4 SET AMHIENS=$SELECT($GET(MSRREC):MSRREC_",",1:"+1,")
+5 SET AMHFDA(9002011.12,AMHIENS,.04)=V
+6 SET AMHFDA(9002011.12,AMHIENS,1204)=PR
+7 IF $GET(MSRREC)
Begin DoDot:1
+8 SET AMHIENS=MSRREC_","
+9 DO FILE^DIE("K","AMHFDA","AMHERRR")
+10 IF $DATA(AMHERRR)
SET AMHER="0~Edit Measurement"
End DoDot:1
QUIT
+11 SET AMHFDA(9002011.12,AMHIENS,.01)=MS
+12 SET AMHFDA(9002011.12,AMHIENS,.02)=P
+13 SET AMHFDA(9002011.12,AMHIENS,.03)=RC
+14 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+15 IF $DATA(AMHERRR)
SET AMHER="0~Add Measurement"
+16 QUIT
+17 ;
DELMSR(REC,MSR) ;EP -- delete a measurement if removed from the client side
+1 NEW ADA,R,M
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(MSR(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW MSRIEN,MSRE
+5 SET MSRE=$PIECE(MSR(ADA),R)
+6 SET MSRIEN=$ORDER(^AUTTMSR("B",MSRE,0))
+7 SET M(MSRIEN)=MSRIEN
End DoDot:1
+8 NEW IEN
+9 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRMSR("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+10 NEW MSRI
+11 SET MSRI=$PIECE(^AMHRMSR(IEN,0),U)
+12 IF '$GET(M(MSRI))
Begin DoDot:2
+13 SET DIK="^AMHRMSR("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
ASS(D,RC,A,P,IT,PP,PRG,EDT) ;EP -- file assessment
+1 ;Q:$G(A)=""
+2 IF $GET(D)="A"
IF $GET(A)=""
QUIT
+3 ;I '$O(^AMHRINTK("AD",RC,0)),$G(A)="" Q
+4 NEW AMHWP
+5 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,A)
+6 NEW AMHFDA,AMHIENS,AMHERRR,AMHIT
+7 SET AMHIENS=""
+8 ;S AMHIENS(1)=P
+9 IF $GET(IT)
Begin DoDot:1
+10 SET AMHIENS=IT_","
+11 SET AMHIT=IT
+12 SET AMHFDA(9002011.13,AMHIENS,.06)=PP
+13 SET AMHFDA(9002011.13,AMHIENS,.07)=DT
+14 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+15 IF $ORDER(^AMHRINTK(IT,11,RC,"B",0))
QUIT
+16 NEW AMHFDA,AMHIENS,AMHERRR
+17 SET AMHIENS="+2,"_IT_","
+18 SET AMHFDA(9002011.1311,AMHIENS,.01)=RC
+19 IF '$DATA(^AMHRINTK(IT,11))
SET AMHFDA(9002011.1311,AMHIENS,.02)=1
+20 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+21 IF $DATA(AMHERRR)
SET AMHER="0~Edit Assessment"
End DoDot:1
+22 IF '$GET(IT)
Begin DoDot:1
+23 SET AMHFDA(9002011.13,"+1,",.01)=EDT
+24 SET AMHFDA(9002011.13,"+1,",.02)=P
+25 SET AMHFDA(9002011.13,"+1,",.03)=RC
+26 SET AMHFDA(9002011.13,"+1,",.04)=PP
+27 SET AMHFDA(9002011.13,"+1,",.05)=PRG
+28 SET AMHFDA(9002011.13,"+1,",.06)=PP
+29 SET AMHFDA(9002011.13,"+1,",.07)=DT
+30 SET AMHFDA(9002011.13,"+1,",.09)="I"
+31 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+32 IF $DATA(AMHERRR)
SET AMHER="0~Add Assessment"
QUIT
+33 SET AMHIT=$GET(AMHIENS(1))
+34 NEW AMHVFDA,AMHVIENS,AMHVERR,AMHVRS
+35 SET AMHVIENS="+2,+1,"
+36 SET AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.01)=RC
+37 SET AMHVFDA(9002011.1311,"+2,"_AMHIT_",",.02)=1
+38 DO UPDATE^DIE("","AMHVFDA","AMHVIENS","AMHVERR")
+39 SET AMHVRS=$GET(AMHVIENS(2))
End DoDot:1
+40 NEW AMHFDA,AMHIENS,AMHERRR
+41 SET AMHIENS=AMHIT_","
+42 DO WP^AMHGU(.AMHERRR,9002011.13,AMHIENS,4100,.AMHWP)
+43 QUIT
+44 ;
CD(D,RC,P,CDC,CDT,TOC,DRT,DIA) ;EP -- file CD data
+1 NEW AMHFDA,AMHIENS,AMHERRR
+2 SET AMHIENS=RC_","
+3 SET AMHFDA(9002011,AMHIENS,1101)=CDC
+4 SET AMHFDA(9002011,AMHIENS,1105)=CDT
+5 SET AMHFDA(9002011,AMHIENS,.32)=TOC
+6 SET AMHFDA(9002011,AMHIENS,1102)=DRT
+7 SET AMHFDA(9002011,AMHIENS,1103)=DIA
+8 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+9 IF $DATA(AMHERRR)
SET AMHER="0~Edit CD Data"
+10 QUIT
+11 ;
