AMHGECM ; IHS/CMI/MAW - AMHG Case Management Adds/Edits 3/3/2009 5:00:28 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
D DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
Q
;
CM(AMHIEN,DM,REC,PRO,CO,PP,PV,CA,NR,DC,DSP,PAT,CMT) ;EP -- file the case status
N AMHFDA,AMHIENS,AMHERRR,FL
S FL=9002011.58
S AMHIENS=$S(DM="A":"+1,",1:REC_",")
S AMHFDA(FL,AMHIENS,.02)=PAT
S AMHFDA(FL,AMHIENS,.03)=PRO
S AMHFDA(FL,AMHIENS,.04)=CA
S AMHFDA(FL,AMHIENS,.05)=DC
S AMHFDA(FL,AMHIENS,.06)=DSP
S AMHFDA(FL,AMHIENS,.08)=PP
S AMHFDA(FL,AMHIENS,.09)=PV
S AMHFDA(FL,AMHIENS,.12)=NR
S AMHFDA(FL,AMHIENS,1101)=CMT
I DM="A" D Q
. S AMHFDA(FL,AMHIENS,.01)=CO
. S AMHFDA(FL,AMHIENS,.11)=DT
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0")
. I '$D(AMHERRR) S AMHIEN=$G(AMHIENS(1)) Q
. S AMHER="0~Add Case"
I DM="E" D Q
. S AMHFDA(FL,AMHIENS,.01)=CO
. D FILE^DIE("K","AMHFDA","AMHERRR(0)")
. I '$D(AMHERRR) S AMHIEN=REC Q
. S AMHER="0~Edit Case"
Q
;
PI(AMHIEN,DM,REC,DMP,DSP,DCP,DPO,DONA,DONB,FLG,FLGN) ;EP -- file the patient information
N AMHFDA,AMHIENS,AMHERRR,FL
S FL=9002011.55
S AMHIENS=$S(DM="A":"+1,",1:REC_",")
I '$D(^AMHPATR(REC)) S AMHIENS="+1,",DM="A"
I $D(^AMHPATR(REC)) S AMHIENS=REC_",",DM="E"
S AMHIENS(1)=REC
S AMHFDA(FL,AMHIENS,.02)=DMP
S AMHFDA(FL,AMHIENS,.03)=DSP
S AMHFDA(FL,AMHIENS,.04)=DCP
S AMHFDA(FL,AMHIENS,.09)=FLG
S AMHFDA(FL,AMHIENS,.11)=FLGN
S AMHFDA(FL,AMHIENS,.12)=DPO
S AMHFDA(FL,AMHIENS,.13)=DONA
S AMHFDA(FL,AMHIENS,.14)=DONB
I DM="A" D Q
. S AMHFDA(FL,AMHIENS,.01)=REC
. D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0")
. I '$D(AMHERRR) S AMHIEN=$G(AMHIENS(1)) Q
. S AMHER="0~Add Patient Information"
I DM="E" D Q
. D FILE^DIE("K","AMHFDA","AMHERRR(0)")
. I '$D(AMHERRR) S AMHIEN=REC Q
. S AMHER="0~Edit Patient Information"
Q
;
PH(AMHIEN,D,RC,PHSTR) ;EP -- add/edit/delete Personal History
N PHS
D ARRAY^AMHGU(.PHS,PHSTR)
N AMHDA
S AMHDA=0 F S AMHDA=$O(PHS(AMHDA)) Q:'AMHDA D
. N PH
. S PH=+$G(PHS(AMHDA))
. D MODPH(PH,RC)
D DELPH(RC,.PHS)
Q
;
MODPH(PI,R) ;-- add a personal history
Q:$$FNDPH^AMHGU(R,PI)
N AMHFDA,AMHIENS,AMHERRR,AMHPIEN
S AMHIENS="+1,"
S AMHFDA(9002011.52,AMHIENS,.01)=PI
S AMHFDA(9002011.52,AMHIENS,.02)=R
S AMHFDA(9002011.52,AMHIENS,.03)=DT
D UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
I $D(AMHERRR) S AMHER="0~Add Personal History"
S AMHPIEN=$G(AMHIENS(1))
Q
;
DELPH(REC,PHI) ;-- check to see if any personal history records were deleted during edit
N ADA,R,C,PH
S R="~"
S ADA=0 F S ADA=$O(PHI(ADA)) Q:'ADA D
. N PHIEN
. S PHIEN=$P(PHI(ADA),R)
. S PH(PHIEN)=PHIEN
N IEN
S IEN=0 F S IEN=$O(^AMHPPHX("AA",REC,IEN)) Q:'IEN D
. I '$G(PH(IEN)) D
.. S DIK="^AMHPPHX(",DA=$O(^AMHPPHX("AA",REC,IEN,0)) D ^DIK
Q
;
AMHGECM ; IHS/CMI/MAW - AMHG Case Management Adds/Edits 3/3/2009 5:00:28 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
DEBUG(RETVAL,AMHSTR) ;-- debug entry point
+1 DO DEBUG^%Serenji("EP^AMHGD(RETVAL,.AMHSTR)")
+2 QUIT
+3 ;
CM(AMHIEN,DM,REC,PRO,CO,PP,PV,CA,NR,DC,DSP,PAT,CMT) ;EP -- file the case status
+1 NEW AMHFDA,AMHIENS,AMHERRR,FL
+2 SET FL=9002011.58
+3 SET AMHIENS=$SELECT(DM="A":"+1,",1:REC_",")
+4 SET AMHFDA(FL,AMHIENS,.02)=PAT
+5 SET AMHFDA(FL,AMHIENS,.03)=PRO
+6 SET AMHFDA(FL,AMHIENS,.04)=CA
+7 SET AMHFDA(FL,AMHIENS,.05)=DC
+8 SET AMHFDA(FL,AMHIENS,.06)=DSP
+9 SET AMHFDA(FL,AMHIENS,.08)=PP
+10 SET AMHFDA(FL,AMHIENS,.09)=PV
+11 SET AMHFDA(FL,AMHIENS,.12)=NR
+12 SET AMHFDA(FL,AMHIENS,1101)=CMT
+13 IF DM="A"
Begin DoDot:1
+14 SET AMHFDA(FL,AMHIENS,.01)=CO
+15 SET AMHFDA(FL,AMHIENS,.11)=DT
+16 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0")
+17 IF '$DATA(AMHERRR)
SET AMHIEN=$GET(AMHIENS(1))
QUIT
+18 SET AMHER="0~Add Case"
End DoDot:1
QUIT
+19 IF DM="E"
Begin DoDot:1
+20 SET AMHFDA(FL,AMHIENS,.01)=CO
+21 DO FILE^DIE("K","AMHFDA","AMHERRR(0)")
+22 IF '$DATA(AMHERRR)
SET AMHIEN=REC
QUIT
+23 SET AMHER="0~Edit Case"
End DoDot:1
QUIT
+24 QUIT
+25 ;
PI(AMHIEN,DM,REC,DMP,DSP,DCP,DPO,DONA,DONB,FLG,FLGN) ;EP -- file the patient information
+1 NEW AMHFDA,AMHIENS,AMHERRR,FL
+2 SET FL=9002011.55
+3 SET AMHIENS=$SELECT(DM="A":"+1,",1:REC_",")
+4 IF '$DATA(^AMHPATR(REC))
SET AMHIENS="+1,"
SET DM="A"
+5 IF $DATA(^AMHPATR(REC))
SET AMHIENS=REC_","
SET DM="E"
+6 SET AMHIENS(1)=REC
+7 SET AMHFDA(FL,AMHIENS,.02)=DMP
+8 SET AMHFDA(FL,AMHIENS,.03)=DSP
+9 SET AMHFDA(FL,AMHIENS,.04)=DCP
+10 SET AMHFDA(FL,AMHIENS,.09)=FLG
+11 SET AMHFDA(FL,AMHIENS,.11)=FLGN
+12 SET AMHFDA(FL,AMHIENS,.12)=DPO
+13 SET AMHFDA(FL,AMHIENS,.13)=DONA
+14 SET AMHFDA(FL,AMHIENS,.14)=DONB
+15 IF DM="A"
Begin DoDot:1
+16 SET AMHFDA(FL,AMHIENS,.01)=REC
+17 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(0")
+18 IF '$DATA(AMHERRR)
SET AMHIEN=$GET(AMHIENS(1))
QUIT
+19 SET AMHER="0~Add Patient Information"
End DoDot:1
QUIT
+20 IF DM="E"
Begin DoDot:1
+21 DO FILE^DIE("K","AMHFDA","AMHERRR(0)")
+22 IF '$DATA(AMHERRR)
SET AMHIEN=REC
QUIT
+23 SET AMHER="0~Edit Patient Information"
End DoDot:1
QUIT
+24 QUIT
+25 ;
PH(AMHIEN,D,RC,PHSTR) ;EP -- add/edit/delete Personal History
+1 NEW PHS
+2 DO ARRAY^AMHGU(.PHS,PHSTR)
+3 NEW AMHDA
+4 SET AMHDA=0
FOR
SET AMHDA=$ORDER(PHS(AMHDA))
IF 'AMHDA
QUIT
Begin DoDot:1
+5 NEW PH
+6 SET PH=+$GET(PHS(AMHDA))
+7 DO MODPH(PH,RC)
End DoDot:1
+8 DO DELPH(RC,.PHS)
+9 QUIT
+10 ;
MODPH(PI,R) ;-- add a personal history
+1 IF $$FNDPH^AMHGU(R,PI)
QUIT
+2 NEW AMHFDA,AMHIENS,AMHERRR,AMHPIEN
+3 SET AMHIENS="+1,"
+4 SET AMHFDA(9002011.52,AMHIENS,.01)=PI
+5 SET AMHFDA(9002011.52,AMHIENS,.02)=R
+6 SET AMHFDA(9002011.52,AMHIENS,.03)=DT
+7 DO UPDATE^DIE("","AMHFDA","AMHIENS","AMHERRR(1)")
+8 IF $DATA(AMHERRR)
SET AMHER="0~Add Personal History"
+9 SET AMHPIEN=$GET(AMHIENS(1))
+10 QUIT
+11 ;
DELPH(REC,PHI) ;-- check to see if any personal history records were deleted during edit
+1 NEW ADA,R,C,PH
+2 SET R="~"
+3 SET ADA=0
FOR
SET ADA=$ORDER(PHI(ADA))
IF 'ADA
QUIT
Begin DoDot:1
+4 NEW PHIEN
+5 SET PHIEN=$PIECE(PHI(ADA),R)
+6 SET PH(PHIEN)=PHIEN
End DoDot:1
+7 NEW IEN
+8 SET IEN=0
FOR
SET IEN=$ORDER(^AMHPPHX("AA",REC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+9 IF '$GET(PH(IEN))
Begin DoDot:2
+10 SET DIK="^AMHPPHX("
SET DA=$ORDER(^AMHPPHX("AA",REC,IEN,0))
DO ^DIK
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
