- 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 ;