AMHGSVF ; IHS/CMI/MAW - AMHG Save Visit Form Data (frmVisitDataEntry) 2/12/2009 3:01:26 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,3,4,5,6,10**;JUN 02, 2010;Build 15
;
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("PN^AMHGSVF(.RETVAL,.AMHSTR)")
Q
;
VISIT(RETVAL,AMHSTR) ;-- save visit form, called from method SaveVisit in clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHPP,AMHPRO,AMHCLN,AMHTOC,AMHARR,AMHEDT,AMHLOC,AMHAW,AMHCOM,AMHP,AMHER,AMHGN,AMHTIG,AMHTM,AMHESIG,AMHTMP,AMHATG
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHPP=$P(AMHSTR,P,3)
S AMHPRO=$P(AMHSTR,P,4)
S AMHPRO=$$SCI^AMHGT(9002011,.02,AMHPRO)
S AMHCLN=$P(AMHSTR,P,5)
S AMHTOC=$P(AMHSTR,P,6)
S AMHARR=$TR($P(AMHSTR,P,7),":")
S AMHEDT=+$P(AMHSTR,P,8)
;S AMHTM=+$$TM^AMHGU($P(AMHEDT,".",2))
S AMHTMP=+$P(AMHEDT,".",2)
S AMHLOC=$P(AMHSTR,P,9)
S AMHAW=$P(AMHSTR,P,10)
S AMHAW=$$SCI^AMHGT(9002011,.11,AMHAW)
S AMHCOM=$P(AMHSTR,P,11)
S AMHP=$P(AMHSTR,P,12)
S AMHGN=$P(AMHSTR,P,13)
S AMHTIG=$P(AMHSTR,P,14)
S AMHESIG=$P(AMHSTR,P,15)
S AMHATG=$P(AMHSTR,P,16)
D MODV^AMHGEVF(.AMHIEN,AMHDM,AMHREC,AMHPP,AMHPRO,AMHCLN,AMHTOC,AMHARR,AMHEDT,AMHLOC,AMHAW,AMHCOM,AMHP,AMHGN,AMHTIG,AMHATG)
;cmi/maw v4.0p10 update the call below to not change the record if an edit and already signed
I $G(AMHESIG) D UPDREC^AMHGESIG(AMHIEN,DUZ)
S @RETVAL@(AMHI)="T00010BMXIEN"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=+$G(AMHIEN)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
POV(RETVAL,AMHSTR) ;-- save POV called from method SavePOV in clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHA2,AMHA3,AMHA4,AMHA5,AMHP,AMHER,AMHGAF
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
K ^AMHTMP($J)
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHA2=$P(AMHSTR,P,3)
S AMHA3=$P(AMHSTR,P,4)
S AMHA4=$P(AMHSTR,P,5)
S AMHA5=$P(AMHSTR,P,6)
S AMHP=$P(AMHSTR,P,7)
S AMHGAF=$P(AMHSTR,P,8)
N AMH2,AMH4
D ARRAY^AMHGU(.AMH2,AMHA2)
D ARRAY^AMHGU(.AMH4,AMHA4)
D AXIS2(AMHDM,AMHREC,AMHP,.AMH2)
D AXIS3(AMHDM,AMHREC,AMHP,AMHA3)
D AXIS4(AMHDM,AMHREC,AMHP,.AMH4)
D AXIS5(AMHDM,AMHREC,AMHP,AMHA5,AMHGAF)
;D VAUD^AMHGEVF(AMHREC)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AXIS2(D,RC,P,A2) ;EP -- add/modify pov
N AMHDA,R,AMHN
S R="~"
D CLNPOV(RC) ;ihs/cmi/maw patch 3 remove all povs before readding or editing since primary and secondary not segregated
S AMHDA=0 F S AMHDA=$O(A2(AMHDA)) Q:'AMHDA D
. N STR,PIEN,PCODE,PNARR
. S STR=$G(A2(AMHDA))
. S PIEN=$P(STR,R)
. S PCODE=$P(STR,R,2)
. S PNARR=$P(STR,R,3)
. I $G(PNARR)]"" D
..S AMHN=$$FNDNARR^AMHGU(PNARR,1)
. D ADDPOV^AMHGEVF(PIEN,P,RC,$G(AMHN))
. Q
. ;below code was used before patch 3 not needed anymore
. I D="A" D ADDPOV^AMHGEVF(PIEN,P,RC,$G(AMHN)) Q
. I D="E" D Q
.. N AMHPREC
.. S AMHPREC=$$FNDPOV^AMHGU(PIEN,RC)
.. I 'AMHPREC D ADDPOV^AMHGEVF(PIEN,P,RC,$G(AMHN)) Q
.. D EDITPOV^AMHGEVF(AMHPREC,$G(AMHN))
I D="E" D Q
. D DELPOV^AMHGEVF(RC,.A2)
Q
;
CLNPOV(REC) ;-- clean out all POV records first
N IEN
S IEN=0 F S IEN=$O(^AMHRPRO("AD",REC,IEN)) Q:'IEN D
. S DIK="^AMHRPRO(",DA=IEN D ^DIK
Q
;
AXIS3(D,RC,P,A3) ;-- file axis 3 data
Q:$G(A3)=""
N AMHWP
D ARRAYT^AMHGU(.AMHWP,A3) ;parse the text into an array
N AMHFDA,AMHIENS,AMHERRR
S AMHIENS=RC_","
D WP^AMHGU(.AMHERRR,9002011,AMHIENS,5301,.AMHWP)
Q
;
AXIS4(D,RC,P,A4) ;-- file axis 4 data
N AMHDA,R
S R="~"
I D="E" D CLNA4^AMHGEVF(RC)
S AMHDA=0 F S AMHDA=$O(A4(AMHDA)) Q:'AMHDA D
. N STR,PIEN,PCODE,PNARR
. S STR=$G(A4(AMHDA))
. S PIEN=$P(STR,R)
. S PCODE=$P(STR,R,2)
. S PNARR=$P(STR,R,3)
. D ADDAXIS4^AMHGEVF(PIEN,P,RC,PNARR) Q
Q
;
AXIS5(D,RC,P,A5,GAF) ;-- file axis 5 data
N AMHFDA,AMHIENS,AMHERRR,AMHA5
S AMHIENS=RC_","
S AMHFDA(9002011,AMHIENS,.14)=A5
S AMHFDA(9002011,AMHIENS,1115)=GAF
D FILE^DIE("K","AMHFDA","AMHERRR(1)")
I '$D(AMHERRR) S AMHA5=RC
Q
;
ACT(RETVAL,AMHSTR) ;-- save activity tab, called from method SaveActivity in clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHACT,AMHVF,AMHAT,AMHIU,AMHLSS,AMHNS,AMHER,AMHCPT,AMHSP
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHACT=$P(AMHSTR,P,3)
S AMHVF=$P(AMHSTR,P,4)
S AMHAT=$P(AMHSTR,P,5)
S AMHIU=$P(AMHSTR,P,6)
S AMHLSS=$P(AMHSTR,P,7)
S AMHNS=$P(AMHSTR,P,8)
S AMHCPT=$P(AMHSTR,P,9)
S AMHSP=$P(AMHSTR,P,10)
S AMHP=$P(AMHSTR,P,11)
D ACT^AMHGEVF(.AMHIEN,AMHDM,AMHREC,AMHACT,AMHVF,AMHAT,AMHIU,AMHLSS,AMHNS,AMHP)
D CPT(AMHDM,AMHREC,AMHP,AMHCPT)
D SP(AMHDM,AMHREC,AMHP,AMHSP)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CPT(D,RC,P,CPT) ;-- file cpt codes from activity tab
N ACPT,QTY,MOD1,MOD2,R
S R="~"
D ARRAY^AMHGU(.ACPT,.CPT)
N AMHDA
S AMHDA=0 F S AMHDA=$O(ACPT(AMHDA)) Q:'AMHDA D
. N CPT
. S CPT=+$P(ACPT(AMHDA),R)
. S QTY=+$P(ACPT(AMHDA),R,4)
. I QTY<1 S QTY=1
. S MOD1=$P(ACPT(AMHDA),R,5)
. S MOD2=$P(ACPT(AMHDA),R,6)
. D MODCPT^AMHGEVF(CPT,QTY,MOD1,MOD2,P,RC)
I D="E" D DELCPT^AMHGEVF(RC,.ACPT)
Q
;
SP(D,RC,P,SP) ;EP -- file secondary providers from activity tab
N ASP
D ARRAY^AMHGU(.ASP,.SP)
I D="E" D DELPRV^AMHGEVF(RC,.ASP,"S")
N AMHDA
S AMHDA=0 F S AMHDA=$O(ASP(AMHDA)) Q:'AMHDA D
. N PRV
. S PRV=+$G(ASP(AMHDA))
. D MODPRV^AMHGEVF(PRV,D,RC,P,"S")
;ihs/cmi/maw 01.16.2013 v4.0p3 moved call to above to cleanup secondary providers
;I D="E" D DELPRV^AMHGEVF(RC,.ASP,"S")
Q
;
PN(RETVAL,AMHSTR) ;-- file progress notes tab called from SaveProgressNotes method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHCC,AMHPN,AMHCMT,AMHPD,AMHPLN,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHCC=$P(AMHSTR,P,3)
S AMHPN=$P(AMHSTR,P,4)
S AMHCMT=$P(AMHSTR,P,5)
S AMHPD=$P(AMHSTR,P,6)
S AMHPLN=$P(AMHSTR,P,7)
S AMHP=$P(AMHSTR,P,8)
D CCPD^AMHGEVF(AMHDM,AMHREC,AMHCC,AMHPD,AMHPLN,AMHP)
D PN^AMHGEVF(AMHDM,AMHREC,AMHPN,AMHP)
D CMT^AMHGEVF(AMHDM,AMHREC,AMHCMT,AMHP)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
RX(RETVAL,AMHSTR) ;-- file rx notes tab, called from the SaveRX method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHRX,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHRX=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P,4)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
D RX^AMHGEVF(AMHDM,AMHREC,AMHRX,AMHP)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
EDU(RETVAL,AMHSTR) ;-- file the education topics from the wellness tab, called from the SaveEducationTopics method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHEDU,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHEDU=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P,4)
N EDU
D ARRAY^AMHGU(.EDU,AMHEDU)
N AMHDA
S AMHDA=0 F S AMHDA=$O(EDU(AMHDA)) Q:'AMHDA D
. N EDUE,EDUI,TIME,LOU,CMT,CPT,STA,GOAL,IG,REA,PRVI
. S EDU=$P(EDU(AMHDA),R)
. S EDUI=$O(^AUTTEDT("B",EDU,0))
. S TIME=$P(EDU(AMHDA),R,2)
. S LOU=$$SCI^AMHGT(9002011.05,.08,$P(EDU(AMHDA),R,3))
. S CMT=$P(EDU(AMHDA),R,4)
. S CPT=$P(EDU(AMHDA),R,5)
. I $G(CPT)]"" S CPT=$O(^ICPT("B",CPT,0))
. S STA=$$SCI^AMHGT(9002011.05,.11,$P(EDU(AMHDA),R,6))
. S GOAL=$P(EDU(AMHDA),R,7)
. S IG=$P(EDU(AMHDA),R,8)
. S REA=$S($P(EDU(AMHDA),R,9)]"":$O(^AUTTRTL("B",$P(EDU(AMHDA),R,9),0)),1:"")
. S PRVI=$P(EDU(AMHDA),R,10)
. D MODEDU^AMHGEVF(AMHDM,AMHREC,AMHP,EDUI,TIME,LOU,CMT,CPT,STA,GOAL,IG,REA,PRVI)
I AMHDM="E" D DELEDU^AMHGEVF(AMHREC,.EDU)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
HF(RETVAL,AMHSTR) ;-- file the health factors from the wellness tab, called from the SaveHealthFactors method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHHF,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHHF=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P,4)
N HF
D ARRAY^AMHGU(.HF,AMHHF)
N AMHDA
S AMHDA=0 F S AMHDA=$O(HF(AMHDA)) Q:'AMHDA D
. N HFE,HFI,LS,QTY,CMT
. S HFE=$P(HF(AMHDA),R)
. S HFI=$O(^AUTTHF("B",HFE,0))
. S LS=$$SCI^AMHGT(9002011.08,.04,$P(HF(AMHDA),R,2))
. S QTY=$P(HF(AMHDA),R,3)
. S CMT=$P(HF(AMHDA),R,4)
. D MODHF^AMHGEVF(AMHDM,AMHREC,AMHP,HFI,LS,QTY,CMT)
I AMHDM="E" D DELHF^AMHGEVF(AMHREC,.HF)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
SCREEN(RETVAL,AMHSTR) ;file screening from the wellness tab, called from the SaveScreening method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHPP,AMHP,AMHER,AMHAPRV,AMHDPRV,AMHIPRV
N AMHS,AMHSC,AMHSPRV
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHA=$$SCI^AMHGT(9002011,1403,$P(AMHSTR,P,3))
S AMHAC=$P(AMHSTR,P,4)
S AMHD=$$SCI^AMHGT(9002011,1405,$P(AMHSTR,P,5))
S AMHDC=$P(AMHSTR,P,6)
S AMHIP=$$SCI^AMHGT(9002011,1401,$P(AMHSTR,P,7))
S AMHIPC=$P(AMHSTR,P,8)
S AMHPP=$P(AMHSTR,P,9)
S AMHP=$P(AMHSTR,P,10)
S AMHAPRV=$P(AMHSTR,P,11)
S AMHDPRV=$P(AMHSTR,P,12)
S AMHIPRV=$P(AMHSTR,P,13)
S AMHS=$$SCI^AMHGT(9002011,1407,$P(AMHSTR,P,14))
S AMHSC=$P(AMHSTR,P,15)
S AMHSPRV=$P(AMHSTR,P,16)
D SCREEN^AMHGEVF(AMHDM,AMHREC,AMHP,AMHPP,AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHAPRV,AMHDPRV,AMHIPRV,AMHS,AMHSC,AMHSPRV)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
MSR(RETVAL,AMHSTR) ;-- file measurements from the measurements tab, called from the SaveMeasurements tab of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHMSR,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHMSR=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P,4)
N MSR
D ARRAY^AMHGU(.MSR,AMHMSR)
N AMHDA
S AMHDA=0 F S AMHDA=$O(MSR(AMHDA)) Q:'AMHDA D
. N MSRE,MSRI,VAL,PRVI
. S MSRE=$P(MSR(AMHDA),R)
. S MSRI=$O(^AUTTMSR("B",MSRE,0))
. S VAL=$P(MSR(AMHDA),R,3)
. S PRVI=$P(MSR(AMHDA),R,4)
. D MODMSR^AMHGEVF(AMHDM,AMHREC,AMHP,MSRI,VAL,PRVI)
I AMHDM="E" D DELMSR^AMHGEVF(AMHREC,.MSR)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
ASS(RETVAL,AMHSTR) ;-- save assessment from assessment tab, called from SaveAssessment method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHA,AMHP,AMHER,AMHIT,AMHPP,AMHPRG,AMHEDT
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHA=$P(AMHSTR,P,3)
S AMHP=$P(AMHSTR,P,4)
S AMHIT=$P(AMHSTR,P,5)
S AMHPP=$P(AMHSTR,P,6)
S AMHPRG=$$SCI^AMHGT(9002011,.02,$P(AMHSTR,P,7))
S AMHEDT=$P($P(AMHSTR,P,8),".")
D ASS^AMHGEVF(AMHDM,AMHREC,AMHA,AMHP,AMHIT,AMHPP,AMHPRG,AMHEDT)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
CD(RETVAL,AMHSTR) ;-- save CD data from CD Data tab, called from SaveCDData method of clsVisitDataEntry
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHCDC,AMHCDT,AMHTOC,AMHDIR,AMHDIA,AMHP,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHDM=$P(AMHSTR,P)
S AMHREC=$P(AMHSTR,P,2)
S AMHCDC=$P(AMHSTR,P,3)
S AMHCDT=$P(AMHSTR,P,4)
S AMHTOC=$P(AMHSTR,P,5)
S AMHDIR=$P(AMHSTR,P,6)
S AMHDIA=$P(AMHSTR,P,7)
S AMHP=$P(AMHSTR,P,8)
D CD^AMHGEVF(AMHDM,AMHREC,AMHP,AMHCDC,AMHCDT,AMHTOC,AMHDIR,AMHDIA)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
DEL(RETVAL,AMHSTR) ;-- mark a record as deleted
S X="MERR^AMHGU",@^%ZOSF("TRAP") ; m error trap
N AMHI,P,R,AMHDM,AMHREC,AMHER
S P="|",R="~"
S RETVAL="^AMHTMP("_$J_")"
S AMHI=0
I $G(AMHSTR)="" D CATSTR^AMHGU(.AMHSTR,.AMHSTR)
K ^AMHTMP($J)
S AMHREC=$P(AMHSTR,P)
D EN^AMHGVDEL(.AMHREC,AMHREC)
I $E($G(RET),1,2)="-1" D
. S AMHER="0~"_$P(RET,$C(30),2)
S @RETVAL@(AMHI)="T00030Result"_$C(30)
S AMHI=AMHI+1
S @RETVAL@(AMHI)=$S($G(AMHER)]"":AMHER,1:AMHREC)_$C(30)
S @RETVAL@(AMHI+1)=$C(31)
Q
;
AMHGSVF ; IHS/CMI/MAW - AMHG Save Visit Form Data (frmVisitDataEntry) 2/12/2009 3:01:26 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,3,4,5,6,10**;JUN 02, 2010;Build 15
+2 ;
+3 ;
+4 ;
+5 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("PN^AMHGSVF(.RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
VISIT(RETVAL,AMHSTR) ;-- save visit form, called from method SaveVisit in clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHPP,AMHPRO,AMHCLN,AMHTOC,AMHARR,AMHEDT,AMHLOC,AMHAW,AMHCOM,AMHP,AMHER,AMHGN,AMHTIG,AMHTM,AMHESIG,AMHTMP,AMHATG
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 SET AMHDM=$PIECE(AMHSTR,P)
+8 SET AMHREC=$PIECE(AMHSTR,P,2)
+9 SET AMHPP=$PIECE(AMHSTR,P,3)
+10 SET AMHPRO=$PIECE(AMHSTR,P,4)
+11 SET AMHPRO=$$SCI^AMHGT(9002011,.02,AMHPRO)
+12 SET AMHCLN=$PIECE(AMHSTR,P,5)
+13 SET AMHTOC=$PIECE(AMHSTR,P,6)
+14 SET AMHARR=$TRANSLATE($PIECE(AMHSTR,P,7),":")
+15 SET AMHEDT=+$PIECE(AMHSTR,P,8)
+16 ;S AMHTM=+$$TM^AMHGU($P(AMHEDT,".",2))
+17 SET AMHTMP=+$PIECE(AMHEDT,".",2)
+18 SET AMHLOC=$PIECE(AMHSTR,P,9)
+19 SET AMHAW=$PIECE(AMHSTR,P,10)
+20 SET AMHAW=$$SCI^AMHGT(9002011,.11,AMHAW)
+21 SET AMHCOM=$PIECE(AMHSTR,P,11)
+22 SET AMHP=$PIECE(AMHSTR,P,12)
+23 SET AMHGN=$PIECE(AMHSTR,P,13)
+24 SET AMHTIG=$PIECE(AMHSTR,P,14)
+25 SET AMHESIG=$PIECE(AMHSTR,P,15)
+26 SET AMHATG=$PIECE(AMHSTR,P,16)
+27 DO MODV^AMHGEVF(.AMHIEN,AMHDM,AMHREC,AMHPP,AMHPRO,AMHCLN,AMHTOC,AMHARR,AMHEDT,AMHLOC,AMHAW,AMHCOM,AMHP,AMHGN,AMHTIG,AMHATG)
+28 ;cmi/maw v4.0p10 update the call below to not change the record if an edit and already signed
+29 IF $GET(AMHESIG)
DO UPDREC^AMHGESIG(AMHIEN,DUZ)
+30 SET @RETVAL@(AMHI)="T00010BMXIEN"_$CHAR(30)
+31 SET AMHI=AMHI+1
+32 SET @RETVAL@(AMHI)=+$GET(AMHIEN)_$CHAR(30)
+33 SET @RETVAL@(AMHI+1)=$CHAR(31)
+34 QUIT
+35 ;
POV(RETVAL,AMHSTR) ;-- save POV called from method SavePOV in clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHA2,AMHA3,AMHA4,AMHA5,AMHP,AMHER,AMHGAF
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 KILL ^AMHTMP($JOB)
+7 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHA2=$PIECE(AMHSTR,P,3)
+11 SET AMHA3=$PIECE(AMHSTR,P,4)
+12 SET AMHA4=$PIECE(AMHSTR,P,5)
+13 SET AMHA5=$PIECE(AMHSTR,P,6)
+14 SET AMHP=$PIECE(AMHSTR,P,7)
+15 SET AMHGAF=$PIECE(AMHSTR,P,8)
+16 NEW AMH2,AMH4
+17 DO ARRAY^AMHGU(.AMH2,AMHA2)
+18 DO ARRAY^AMHGU(.AMH4,AMHA4)
+19 DO AXIS2(AMHDM,AMHREC,AMHP,.AMH2)
+20 DO AXIS3(AMHDM,AMHREC,AMHP,AMHA3)
+21 DO AXIS4(AMHDM,AMHREC,AMHP,.AMH4)
+22 DO AXIS5(AMHDM,AMHREC,AMHP,AMHA5,AMHGAF)
+23 ;D VAUD^AMHGEVF(AMHREC)
+24 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+25 SET AMHI=AMHI+1
+26 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+27 SET @RETVAL@(AMHI+1)=$CHAR(31)
+28 QUIT
+29 ;
AXIS2(D,RC,P,A2) ;EP -- add/modify pov
+1 NEW AMHDA,R,AMHN
+2 SET R="~"
+3 ;ihs/cmi/maw patch 3 remove all povs before readding or editing since primary and secondary not segregated
DO CLNPOV(RC)
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(A2(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 NEW STR,PIEN,PCODE,PNARR
+6 SET STR=$GET(A2(AMHDA))
+7 SET PIEN=$PIECE(STR,R)
+8 SET PCODE=$PIECE(STR,R,2)
+9 SET PNARR=$PIECE(STR,R,3)
+10 IF $GET(PNARR)]""
Begin DoDot:2
+11 SET AMHN=$$FNDNARR^AMHGU(PNARR,1)
End DoDot:2
+12 DO ADDPOV^AMHGEVF(PIEN,P,RC,$GET(AMHN))
+13 QUIT
+14 ;below code was used before patch 3 not needed anymore
+15 IF D="A"
DO ADDPOV^AMHGEVF(PIEN,P,RC,$GET(AMHN))
QUIT
+16 IF D="E"
Begin DoDot:2
+17 NEW AMHPREC
+18 SET AMHPREC=$$FNDPOV^AMHGU(PIEN,RC)
+19 IF 'AMHPREC
DO ADDPOV^AMHGEVF(PIEN,P,RC,$GET(AMHN))
QUIT
+20 DO EDITPOV^AMHGEVF(AMHPREC,$GET(AMHN))
End DoDot:2
QUIT
End DoDot:1
+21 IF D="E"
Begin DoDot:1
+22 DO DELPOV^AMHGEVF(RC,.A2)
End DoDot:1
QUIT
+23 QUIT
+24 ;
CLNPOV(REC) ;-- clean out all POV records first
+1 NEW IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRPRO("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+3 SET DIK="^AMHRPRO("
SET DA=IEN
DO ^DIK
End DoDot:1
+4 QUIT
+5 ;
AXIS3(D,RC,P,A3) ;-- file axis 3 data
+1 IF $GET(A3)=""
QUIT
+2 NEW AMHWP
+3 ;parse the text into an array
DO ARRAYT^AMHGU(.AMHWP,A3)
+4 NEW AMHFDA,AMHIENS,AMHERRR
+5 SET AMHIENS=RC_","
+6 DO WP^AMHGU(.AMHERRR,9002011,AMHIENS,5301,.AMHWP)
+7 QUIT
+8 ;
AXIS4(D,RC,P,A4) ;-- file axis 4 data
+1 NEW AMHDA,R
+2 SET R="~"
+3 IF D="E"
DO CLNA4^AMHGEVF(RC)
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(A4(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 NEW STR,PIEN,PCODE,PNARR
+6 SET STR=$GET(A4(AMHDA))
+7 SET PIEN=$PIECE(STR,R)
+8 SET PCODE=$PIECE(STR,R,2)
+9 SET PNARR=$PIECE(STR,R,3)
+10 DO ADDAXIS4^AMHGEVF(PIEN,P,RC,PNARR)
QUIT
End DoDot:1
+11 QUIT
+12 ;
AXIS5(D,RC,P,A5,GAF) ;-- file axis 5 data
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHA5
+2 SET AMHIENS=RC_","
+3 SET AMHFDA(9002011,AMHIENS,.14)=A5
+4 SET AMHFDA(9002011,AMHIENS,1115)=GAF
+5 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+6 IF '$DATA(AMHERRR)
SET AMHA5=RC
+7 QUIT
+8 ;
ACT(RETVAL,AMHSTR) ;-- save activity tab, called from method SaveActivity in clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHACT,AMHVF,AMHAT,AMHIU,AMHLSS,AMHNS,AMHER,AMHCPT,AMHSP
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHACT=$PIECE(AMHSTR,P,3)
+11 SET AMHVF=$PIECE(AMHSTR,P,4)
+12 SET AMHAT=$PIECE(AMHSTR,P,5)
+13 SET AMHIU=$PIECE(AMHSTR,P,6)
+14 SET AMHLSS=$PIECE(AMHSTR,P,7)
+15 SET AMHNS=$PIECE(AMHSTR,P,8)
+16 SET AMHCPT=$PIECE(AMHSTR,P,9)
+17 SET AMHSP=$PIECE(AMHSTR,P,10)
+18 SET AMHP=$PIECE(AMHSTR,P,11)
+19 DO ACT^AMHGEVF(.AMHIEN,AMHDM,AMHREC,AMHACT,AMHVF,AMHAT,AMHIU,AMHLSS,AMHNS,AMHP)
+20 DO CPT(AMHDM,AMHREC,AMHP,AMHCPT)
+21 DO SP(AMHDM,AMHREC,AMHP,AMHSP)
+22 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+23 SET AMHI=AMHI+1
+24 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+25 SET @RETVAL@(AMHI+1)=$CHAR(31)
+26 QUIT
+27 ;
CPT(D,RC,P,CPT) ;-- file cpt codes from activity tab
+1 NEW ACPT,QTY,MOD1,MOD2,R
+2 SET R="~"
+3 DO ARRAY^AMHGU(.ACPT,.CPT)
+4 NEW AMHDA
+5 SET AMHDA=0
FOR
SET AMHDA=$ORDER(ACPT(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+6 NEW CPT
+7 SET CPT=+$PIECE(ACPT(AMHDA),R)
+8 SET QTY=+$PIECE(ACPT(AMHDA),R,4)
+9 IF QTY<1
SET QTY=1
+10 SET MOD1=$PIECE(ACPT(AMHDA),R,5)
+11 SET MOD2=$PIECE(ACPT(AMHDA),R,6)
+12 DO MODCPT^AMHGEVF(CPT,QTY,MOD1,MOD2,P,RC)
End DoDot:1
+13 IF D="E"
DO DELCPT^AMHGEVF(RC,.ACPT)
+14 QUIT
+15 ;
SP(D,RC,P,SP) ;EP -- file secondary providers from activity tab
+1 NEW ASP
+2 DO ARRAY^AMHGU(.ASP,.SP)
+3 IF D="E"
DO DELPRV^AMHGEVF(RC,.ASP,"S")
+4 NEW AMHDA
+5 SET AMHDA=0
FOR
SET AMHDA=$ORDER(ASP(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+6 NEW PRV
+7 SET PRV=+$GET(ASP(AMHDA))
+8 DO MODPRV^AMHGEVF(PRV,D,RC,P,"S")
End DoDot:1
+9 ;ihs/cmi/maw 01.16.2013 v4.0p3 moved call to above to cleanup secondary providers
+10 ;I D="E" D DELPRV^AMHGEVF(RC,.ASP,"S")
+11 QUIT
+12 ;
PN(RETVAL,AMHSTR) ;-- file progress notes tab called from SaveProgressNotes method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHCC,AMHPN,AMHCMT,AMHPD,AMHPLN,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHCC=$PIECE(AMHSTR,P,3)
+11 SET AMHPN=$PIECE(AMHSTR,P,4)
+12 SET AMHCMT=$PIECE(AMHSTR,P,5)
+13 SET AMHPD=$PIECE(AMHSTR,P,6)
+14 SET AMHPLN=$PIECE(AMHSTR,P,7)
+15 SET AMHP=$PIECE(AMHSTR,P,8)
+16 DO CCPD^AMHGEVF(AMHDM,AMHREC,AMHCC,AMHPD,AMHPLN,AMHP)
+17 DO PN^AMHGEVF(AMHDM,AMHREC,AMHPN,AMHP)
+18 DO CMT^AMHGEVF(AMHDM,AMHREC,AMHCMT,AMHP)
+19 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+20 SET AMHI=AMHI+1
+21 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+22 SET @RETVAL@(AMHI+1)=$CHAR(31)
+23 QUIT
+24 ;
RX(RETVAL,AMHSTR) ;-- file rx notes tab, called from the SaveRX method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHRX,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHRX=$PIECE(AMHSTR,P,3)
+11 SET AMHP=$PIECE(AMHSTR,P,4)
+12 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+13 DO RX^AMHGEVF(AMHDM,AMHREC,AMHRX,AMHP)
+14 SET AMHI=AMHI+1
+15 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+16 SET @RETVAL@(AMHI+1)=$CHAR(31)
+17 QUIT
+18 ;
EDU(RETVAL,AMHSTR) ;-- file the education topics from the wellness tab, called from the SaveEducationTopics method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHEDU,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHEDU=$PIECE(AMHSTR,P,3)
+11 SET AMHP=$PIECE(AMHSTR,P,4)
+12 NEW EDU
+13 DO ARRAY^AMHGU(.EDU,AMHEDU)
+14 NEW AMHDA
+15 SET AMHDA=0
FOR
SET AMHDA=$ORDER(EDU(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+16 NEW EDUE,EDUI,TIME,LOU,CMT,CPT,STA,GOAL,IG,REA,PRVI
+17 SET EDU=$PIECE(EDU(AMHDA),R)
+18 SET EDUI=$ORDER(^AUTTEDT("B",EDU,0))
+19 SET TIME=$PIECE(EDU(AMHDA),R,2)
+20 SET LOU=$$SCI^AMHGT(9002011.05,.08,$PIECE(EDU(AMHDA),R,3))
+21 SET CMT=$PIECE(EDU(AMHDA),R,4)
+22 SET CPT=$PIECE(EDU(AMHDA),R,5)
+23 IF $GET(CPT)]""
SET CPT=$ORDER(^ICPT("B",CPT,0))
+24 SET STA=$$SCI^AMHGT(9002011.05,.11,$PIECE(EDU(AMHDA),R,6))
+25 SET GOAL=$PIECE(EDU(AMHDA),R,7)
+26 SET IG=$PIECE(EDU(AMHDA),R,8)
+27 SET REA=$SELECT($PIECE(EDU(AMHDA),R,9)]"":$ORDER(^AUTTRTL("B",$PIECE(EDU(AMHDA),R,9),0)),1:"")
+28 SET PRVI=$PIECE(EDU(AMHDA),R,10)
+29 DO MODEDU^AMHGEVF(AMHDM,AMHREC,AMHP,EDUI,TIME,LOU,CMT,CPT,STA,GOAL,IG,REA,PRVI)
End DoDot:1
+30 IF AMHDM="E"
DO DELEDU^AMHGEVF(AMHREC,.EDU)
+31 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+32 SET AMHI=AMHI+1
+33 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+34 SET @RETVAL@(AMHI+1)=$CHAR(31)
+35 QUIT
+36 ;
HF(RETVAL,AMHSTR) ;-- file the health factors from the wellness tab, called from the SaveHealthFactors method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHHF,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHHF=$PIECE(AMHSTR,P,3)
+11 SET AMHP=$PIECE(AMHSTR,P,4)
+12 NEW HF
+13 DO ARRAY^AMHGU(.HF,AMHHF)
+14 NEW AMHDA
+15 SET AMHDA=0
FOR
SET AMHDA=$ORDER(HF(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+16 NEW HFE,HFI,LS,QTY,CMT
+17 SET HFE=$PIECE(HF(AMHDA),R)
+18 SET HFI=$ORDER(^AUTTHF("B",HFE,0))
+19 SET LS=$$SCI^AMHGT(9002011.08,.04,$PIECE(HF(AMHDA),R,2))
+20 SET QTY=$PIECE(HF(AMHDA),R,3)
+21 SET CMT=$PIECE(HF(AMHDA),R,4)
+22 DO MODHF^AMHGEVF(AMHDM,AMHREC,AMHP,HFI,LS,QTY,CMT)
End DoDot:1
+23 IF AMHDM="E"
DO DELHF^AMHGEVF(AMHREC,.HF)
+24 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+25 SET AMHI=AMHI+1
+26 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+27 SET @RETVAL@(AMHI+1)=$CHAR(31)
+28 QUIT
+29 ;
SCREEN(RETVAL,AMHSTR) ;file screening from the wellness tab, called from the SaveScreening method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHPP,AMHP,AMHER,AMHAPRV,AMHDPRV,AMHIPRV
+3 NEW AMHS,AMHSC,AMHSPRV
+4 SET P="|"
SET R="~"
+5 SET RETVAL="^AMHTMP("_$JOB_")"
+6 SET AMHI=0
+7 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+8 KILL ^AMHTMP($JOB)
+9 SET AMHDM=$PIECE(AMHSTR,P)
+10 SET AMHREC=$PIECE(AMHSTR,P,2)
+11 SET AMHA=$$SCI^AMHGT(9002011,1403,$PIECE(AMHSTR,P,3))
+12 SET AMHAC=$PIECE(AMHSTR,P,4)
+13 SET AMHD=$$SCI^AMHGT(9002011,1405,$PIECE(AMHSTR,P,5))
+14 SET AMHDC=$PIECE(AMHSTR,P,6)
+15 SET AMHIP=$$SCI^AMHGT(9002011,1401,$PIECE(AMHSTR,P,7))
+16 SET AMHIPC=$PIECE(AMHSTR,P,8)
+17 SET AMHPP=$PIECE(AMHSTR,P,9)
+18 SET AMHP=$PIECE(AMHSTR,P,10)
+19 SET AMHAPRV=$PIECE(AMHSTR,P,11)
+20 SET AMHDPRV=$PIECE(AMHSTR,P,12)
+21 SET AMHIPRV=$PIECE(AMHSTR,P,13)
+22 SET AMHS=$$SCI^AMHGT(9002011,1407,$PIECE(AMHSTR,P,14))
+23 SET AMHSC=$PIECE(AMHSTR,P,15)
+24 SET AMHSPRV=$PIECE(AMHSTR,P,16)
+25 DO SCREEN^AMHGEVF(AMHDM,AMHREC,AMHP,AMHPP,AMHA,AMHAC,AMHD,AMHDC,AMHIP,AMHIPC,AMHAPRV,AMHDPRV,AMHIPRV,AMHS,AMHSC,AMHSPRV)
+26 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+27 SET AMHI=AMHI+1
+28 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+29 SET @RETVAL@(AMHI+1)=$CHAR(31)
+30 QUIT
+31 ;
MSR(RETVAL,AMHSTR) ;-- file measurements from the measurements tab, called from the SaveMeasurements tab of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHMSR,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHMSR=$PIECE(AMHSTR,P,3)
+11 SET AMHP=$PIECE(AMHSTR,P,4)
+12 NEW MSR
+13 DO ARRAY^AMHGU(.MSR,AMHMSR)
+14 NEW AMHDA
+15 SET AMHDA=0
FOR
SET AMHDA=$ORDER(MSR(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+16 NEW MSRE,MSRI,VAL,PRVI
+17 SET MSRE=$PIECE(MSR(AMHDA),R)
+18 SET MSRI=$ORDER(^AUTTMSR("B",MSRE,0))
+19 SET VAL=$PIECE(MSR(AMHDA),R,3)
+20 SET PRVI=$PIECE(MSR(AMHDA),R,4)
+21 DO MODMSR^AMHGEVF(AMHDM,AMHREC,AMHP,MSRI,VAL,PRVI)
End DoDot:1
+22 IF AMHDM="E"
DO DELMSR^AMHGEVF(AMHREC,.MSR)
+23 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+24 SET AMHI=AMHI+1
+25 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+26 SET @RETVAL@(AMHI+1)=$CHAR(31)
+27 QUIT
+28 ;
ASS(RETVAL,AMHSTR) ;-- save assessment from assessment tab, called from SaveAssessment method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHA,AMHP,AMHER,AMHIT,AMHPP,AMHPRG,AMHEDT
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHA=$PIECE(AMHSTR,P,3)
+11 SET AMHP=$PIECE(AMHSTR,P,4)
+12 SET AMHIT=$PIECE(AMHSTR,P,5)
+13 SET AMHPP=$PIECE(AMHSTR,P,6)
+14 SET AMHPRG=$$SCI^AMHGT(9002011,.02,$PIECE(AMHSTR,P,7))
+15 SET AMHEDT=$PIECE($PIECE(AMHSTR,P,8),".")
+16 DO ASS^AMHGEVF(AMHDM,AMHREC,AMHA,AMHP,AMHIT,AMHPP,AMHPRG,AMHEDT)
+17 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+18 SET AMHI=AMHI+1
+19 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+20 SET @RETVAL@(AMHI+1)=$CHAR(31)
+21 QUIT
+22 ;
CD(RETVAL,AMHSTR) ;-- save CD data from CD Data tab, called from SaveCDData method of clsVisitDataEntry
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHCDC,AMHCDT,AMHTOC,AMHDIR,AMHDIA,AMHP,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHDM=$PIECE(AMHSTR,P)
+9 SET AMHREC=$PIECE(AMHSTR,P,2)
+10 SET AMHCDC=$PIECE(AMHSTR,P,3)
+11 SET AMHCDT=$PIECE(AMHSTR,P,4)
+12 SET AMHTOC=$PIECE(AMHSTR,P,5)
+13 SET AMHDIR=$PIECE(AMHSTR,P,6)
+14 SET AMHDIA=$PIECE(AMHSTR,P,7)
+15 SET AMHP=$PIECE(AMHSTR,P,8)
+16 DO CD^AMHGEVF(AMHDM,AMHREC,AMHP,AMHCDC,AMHCDT,AMHTOC,AMHDIR,AMHDIA)
+17 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+18 SET AMHI=AMHI+1
+19 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+20 SET @RETVAL@(AMHI+1)=$CHAR(31)
+21 QUIT
+22 ;
DEL(RETVAL,AMHSTR) ;-- mark a record as deleted
+1 ; m error trap
SET X="MERR^AMHGU"
SET @^%ZOSF("TRAP")
+2 NEW AMHI,P,R,AMHDM,AMHREC,AMHER
+3 SET P="|"
SET R="~"
+4 SET RETVAL="^AMHTMP("_$JOB_")"
+5 SET AMHI=0
+6 IF $GET(AMHSTR)=""
DO CATSTR^AMHGU(.AMHSTR,.AMHSTR)
+7 KILL ^AMHTMP($JOB)
+8 SET AMHREC=$PIECE(AMHSTR,P)
+9 DO EN^AMHGVDEL(.AMHREC,AMHREC)
+10 IF $EXTRACT($GET(RET),1,2)="-1"
Begin DoDot:1
+11 SET AMHER="0~"_$PIECE(RET,$CHAR(30),2)
End DoDot:1
+12 SET @RETVAL@(AMHI)="T00030Result"_$CHAR(30)
+13 SET AMHI=AMHI+1
+14 SET @RETVAL@(AMHI)=$SELECT($GET(AMHER)]"":AMHER,1:AMHREC)_$CHAR(30)
+15 SET @RETVAL@(AMHI+1)=$CHAR(31)
+16 QUIT
+17 ;
