AMHGECOM ; IHS/CMI/MAW - AMHG Community Add/Edits 3/6/2009 5:57:06 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
MODV(AMHIEN,DM,REC,PP,PRO,TOC,ST,AT,NS,TGT,EDT,LOC,COM,AC,LSS,FLG,CLN) ;EP -- add/update MHSS RECORD entry
N AMHFDA,AMHIENS,AMHERRR,AMHREC
S AMHIENS=$S(DM="A":"+1,",1:REC_",")
S AMHFDA(9002011,AMHIENS,.02)=PRO
S AMHFDA(9002011,AMHIENS,.04)=LOC
S AMHFDA(9002011,AMHIENS,.05)=COM
S AMHFDA(9002011,AMHIENS,.06)=AC
S AMHFDA(9002011,AMHIENS,.07)=TOC
S AMHFDA(9002011,AMHIENS,.09)=NS
S AMHFDA(9002011,AMHIENS,.12)=AT
S AMHFDA(9002011,AMHIENS,.19)=DUZ
S AMHFDA(9002011,AMHIENS,.25)=CLN
S AMHFDA(9002011,AMHIENS,.27)=FLG
S AMHFDA(9002011,AMHIENS,.31)=LSS
S AMHFDA(9002011,AMHIENS,.33)="R"
S AMHFDA(9002011,AMHIENS,1106)=TGT
S AMHFDA(9002011,AMHIENS,1111)=1
I DM="A" D Q
. S AMHFDA(9002011,AMHIENS,.01)=EDT
. S AMHFDA(9002011,AMHIENS,.03)=DT
. ;S AMHFDA(9002011,AMHIENS,.17)="A"
. S AMHFDA(9002011,AMHIENS,.19)=DUZ
. S AMHFDA(9002011,AMHIENS,.22)="A"
. 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^AMHGEVF(PP,DM,AMHIEN,"","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^AMHGEVF(PP,DM,AMHIEN,"","P")
. D VAUD(REC) ;update the audit log
Q
;
VAUD(RC) ;-- 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
;
POV(D,RC,P,A2) ;EP -- add/modify pov
N AMHDA,R
S R="~"
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)
. I D="A" D ADDPOV^AMHGEVF(PIEN,P,RC,AMHN) Q
. I D="E" D Q
.. N AMHPREC
.. S AMHPREC=$$FNDPOV^AMHGU(PIEN,RC)
.. I 'AMHPREC D ADDPOV^AMHGEVF(PIEN,P,RC,AMHN) Q
.. D EDITPOV^AMHGEVF(AMHPREC,AMHN)
I D="E" D Q
. D DELPOV^AMHGEVF(RC,.A2)
Q
;
MODPA(PI,PAT,RC,OTH) ;EP -- add a prevention activity
Q:$$FNDPA^AMHGU(RC,PI)
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
S AMHIENS="+1,"
S AMHFDA(9002011.09,AMHIENS,.01)=PI
S AMHFDA(9002011.09,AMHIENS,.02)=PAT
S AMHFDA(9002011.09,AMHIENS,.03)=RC
S AMHFDA(9002011.09,AMHIENS,.04)=OTH
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Prevention Activity"
S AMHPIEN=$G(AMHIENS(1))
Q
;
DELPA(REC,PAC) ;EP -- check to see if any cpt records were deleted during edit
N ADA,R,PA
S R="~"
S ADA=0 F S ADA=$O(PAC(ADA)) Q:'ADA D
. N PAIEN
. S PAIEN=$P(PAC(ADA),R)
. S P(PAIEN)=PAIEN
N IEN
S IEN=0 F S IEN=$O(^AMHRPA("AD",REC,IEN)) Q:'IEN D
. N PAI
. S PAI=$P(^AMHRPA(IEN,0),U)
. I '$G(P(PAI)) D
.. S DIK="^AMHRPA(",DA=IEN D ^DIK
Q
;
AMHGECOM ; IHS/CMI/MAW - AMHG Community Add/Edits 3/6/2009 5:57:06 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
MODV(AMHIEN,DM,REC,PP,PRO,TOC,ST,AT,NS,TGT,EDT,LOC,COM,AC,LSS,FLG,CLN) ;EP -- add/update MHSS RECORD entry
+1 NEW AMHFDA,AMHIENS,AMHERRR,AMHREC
+2 SET AMHIENS=$SELECT(DM="A":"+1,",1:REC_",")
+3 SET AMHFDA(9002011,AMHIENS,.02)=PRO
+4 SET AMHFDA(9002011,AMHIENS,.04)=LOC
+5 SET AMHFDA(9002011,AMHIENS,.05)=COM
+6 SET AMHFDA(9002011,AMHIENS,.06)=AC
+7 SET AMHFDA(9002011,AMHIENS,.07)=TOC
+8 SET AMHFDA(9002011,AMHIENS,.09)=NS
+9 SET AMHFDA(9002011,AMHIENS,.12)=AT
+10 SET AMHFDA(9002011,AMHIENS,.19)=DUZ
+11 SET AMHFDA(9002011,AMHIENS,.25)=CLN
+12 SET AMHFDA(9002011,AMHIENS,.27)=FLG
+13 SET AMHFDA(9002011,AMHIENS,.31)=LSS
+14 SET AMHFDA(9002011,AMHIENS,.33)="R"
+15 SET AMHFDA(9002011,AMHIENS,1106)=TGT
+16 SET AMHFDA(9002011,AMHIENS,1111)=1
+17 IF DM="A"
Begin DoDot:1
+18 SET AMHFDA(9002011,AMHIENS,.01)=EDT
+19 SET AMHFDA(9002011,AMHIENS,.03)=DT
+20 ;S AMHFDA(9002011,AMHIENS,.17)="A"
+21 SET AMHFDA(9002011,AMHIENS,.19)=DUZ
+22 SET AMHFDA(9002011,AMHIENS,.22)="A"
+23 SET AMHFDA(9002011.5101,"+2,"_AMHIENS,.01)=$$NOW^XLFDT
+24 SET AMHFDA(9002011.5101,"+2,"_AMHIENS,.02)=DUZ
+25 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+26 IF $DATA(AMHERRR)
SET AMHER="0~Add Visit"
+27 SET AMHIEN=+$GET(AMHIENS(1))
+28 DO MODPRV^AMHGEVF(PP,DM,AMHIEN,"","P")
End DoDot:1
QUIT
+29 IF DM="E"
Begin DoDot:1
+30 SET AMHIENS(1)=REC
+31 ;S AMHFDA(9002011,AMHIENS,.17)="E"
+32 SET AMHFDA(9002011,AMHIENS,.21)=DT
+33 SET AMHFDA(9002011,AMHIENS,.22)="M"
+34 SET AMHFDA(9002011,AMHIENS,.28)=DUZ
+35 DO FILE^DIE("K","AMHFDA","AMHERRR(1)")
+36 IF $DATA(AMHERRR)
SET AMHER="0~Edit Visit"
+37 SET AMHIEN=REC
+38 DO MODPRV^AMHGEVF(PP,DM,AMHIEN,"","P")
+39 ;update the audit log
DO VAUD(REC)
End DoDot:1
QUIT
+40 QUIT
+41 ;
VAUD(RC) ;-- 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 ;
POV(D,RC,P,A2) ;EP -- add/modify pov
+1 NEW AMHDA,R
+2 SET R="~"
+3 SET AMHDA=0
FOR
SET AMHDA=$ORDER(A2(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+4 NEW STR,PIEN,PCODE,PNARR
+5 SET STR=$GET(A2(AMHDA))
+6 SET PIEN=$PIECE(STR,R)
+7 SET PCODE=$PIECE(STR,R,2)
+8 SET PNARR=$PIECE(STR,R,3)
+9 IF $GET(PNARR)]""
Begin DoDot:2
+10 SET AMHN=$$FNDNARR^AMHGU(PNARR,1)
End DoDot:2
+11 IF D="A"
DO ADDPOV^AMHGEVF(PIEN,P,RC,AMHN)
QUIT
+12 IF D="E"
Begin DoDot:2
+13 NEW AMHPREC
+14 SET AMHPREC=$$FNDPOV^AMHGU(PIEN,RC)
+15 IF 'AMHPREC
DO ADDPOV^AMHGEVF(PIEN,P,RC,AMHN)
QUIT
+16 DO EDITPOV^AMHGEVF(AMHPREC,AMHN)
End DoDot:2
QUIT
End DoDot:1
+17 IF D="E"
Begin DoDot:1
+18 DO DELPOV^AMHGEVF(RC,.A2)
End DoDot:1
QUIT
+19 QUIT
+20 ;
MODPA(PI,PAT,RC,OTH) ;EP -- add a prevention activity
+1 IF $$FNDPA^AMHGU(RC,PI)
QUIT
+2 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+3 SET AMHIENS="+1,"
+4 SET AMHFDA(9002011.09,AMHIENS,.01)=PI
+5 SET AMHFDA(9002011.09,AMHIENS,.02)=PAT
+6 SET AMHFDA(9002011.09,AMHIENS,.03)=RC
+7 SET AMHFDA(9002011.09,AMHIENS,.04)=OTH
+8 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+9 IF $DATA(AMHERRR)
SET AMHER="0~Add Prevention Activity"
+10 SET AMHPIEN=$GET(AMHIENS(1))
+11 QUIT
+12 ;
DELPA(REC,PAC) ;EP -- check to see if any cpt records were deleted during edit
+1 NEW ADA,R,PA
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(PAC(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW PAIEN
+5 SET PAIEN=$PIECE(PAC(ADA),R)
+6 SET P(PAIEN)=PAIEN
End DoDot:1
+7 NEW IEN
+8 SET IEN=0
FOR
SET IEN=$ORDER(^AMHRPA("AD",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 NEW PAI
+10 SET PAI=$PIECE(^AMHRPA(IEN,0),U)
+11 IF '$GET(P(PAI))
Begin DoDot:2
+12 SET DIK="^AMHRPA("
SET DA=IEN
DO ^DIK
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
