AGED3 ; IHS/ASDS/EFG - EDIT PG 3 - EMERGENCY CONTACT/NEXT OF KIN ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
S AG("N")=14
VAR D DRAW
W !,AGLINE("EQ")
K DIR
S DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
S DIR("?")=""
S DIR("?",1)="You may enter the item number of the field you wish to edit,"
S DIR("?",2)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
S DIR("?",3)="the page you wish to jump to, OR enter '^' to go back one page"
S DIR("?",4)="OR, enter '^^' to exit the edit screens, OR RETURN to go to the next screen."
D READ^AGED1
I $D(MYERRS("C","E")),(Y'?1N.N),(Y'=AGOPT("ESCAPE")) W !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!" H 3 G VAR
Q:Y=AGOPT("ESCAPE")
G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))
G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))
Q:$D(DFOUT)!$D(DTOUT)
I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 G VAR
S AG("C")="ECNAME^AG8A,ECPH^AG8A,ECREL^AG8A,ECSTR^AG8A,ECCITY^AG8A,ECST^AG8A,ECZIP^AG8A,NKNAME^AG8B,NKPH^AG8B,NKREL^AG8B,NKSTR^AG8B,NKCITY^AG8B,NKST^AG8B,NKZIP^AG8B"
S AGY=Y
F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N")) D @($P(AG("C"),",",AG("SEL")))
D UPDATE1^AGED(DUZ(2),DFN,3,"")
K AGI,AGY
G VAR
END K AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y
K ROUTID
Q:$D(AGXTERN)
Q:$D(DIROUT)
G ^AGED2:$D(DUOUT),^AGED4A
DRAW ;EP
S AG("PG")=3
S ROUTID=$P($T(+1)," ") ;SET ROUTINE ID FOR PROGRAMMER VIEW
S DA=DFN
D ^AGED
K ^UTILITY("DIQ1",$J)
W !,"--- Emergency Contact Data " F A=1:1:53 W "-"
F AG=1:1:14 D
. S AGSCRN=$P($T(@1+AG),";;",2,15)
. S DIC=$P(AGSCRN,U,3)
. S DR=$P(AGSCRN,U,4)
. I AG=8 W !,"--- Next of Kin Data " F A=1:1:59 W "-"
. W !,AG,".",?(29-$L($P($G(^DD(DIC,DR,0)),U))),$P($G(^DD(DIC,DR,0)),U)," : "
. W $$GET1^DIQ(DIC,DFN,DR)
W !,AGLINE("-")
K MYERRS,MYVARS
D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
Q
; ****************************************************************
; ON LINES BELOW:
; PIECE 1= FLD LBL
; PIECE 2= POSITION ON LINE TO DISP FLD
; PIECE 3= FILE #
; PIECE 4= FIELD #
1 ;
;;EMERGENCY CONTACT^5^2^.331
;;EC PHONE^14^2^.339
;;EC RELATIONSHIP^7^9000001^3102
;;EC ADDRESS-STREET^5^2^.333
;;EC ADDRESS-CITY^7^2^.336
;;EC ADDRESS-STATE^6^2^.337
;;EC ADDRESS-ZIP^8^2^.338
;;NEXT OF KIN^11^2^.211
;;NOK PHONE^13^2^.219
;;NOK RELATIONSHIP^6^9000001^2802
;;NOK ADDRESS-STREET^4^2^.213
;;NOK ADDRESS-CITY^6^2^.216
;;NOK ADDRESS-STATE^5^2^.217
;;NOK ADDRESS-ZIP^7^2^.218
AGED3 ; IHS/ASDS/EFG - EDIT PG 3 - EMERGENCY CONTACT/NEXT OF KIN ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 SET AG("N")=14
VAR DO DRAW
+1 WRITE !,AGLINE("EQ")
+2 KILL DIR
+3 SET DIR("A")="CHANGE which item? (1-"_AG("N")_") NONE// "
+4 SET DIR("?")=""
+5 SET DIR("?",1)="You may enter the item number of the field you wish to edit,"
+6 SET DIR("?",2)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
+7 SET DIR("?",3)="the page you wish to jump to, OR enter '^' to go back one page"
+8 SET DIR("?",4)="OR, enter '^^' to exit the edit screens, OR RETURN to go to the next screen."
+9 DO READ^AGED1
+10 IF $DATA(MYERRS("C","E"))
IF (Y'?1N.N)
IF (Y'=AGOPT("ESCAPE"))
WRITE !,"ERRORS ON THIS PAGE. PLEASE FIX BEFORE EXITING!!"
HANG 3
GOTO VAR
+11 IF Y=AGOPT("ESCAPE")
QUIT
+12 IF $DATA(AG("ED"))&'$DATA(AGXTERN)
GOTO @("^AGED"_AG("ED"))
+13 IF $DATA(DLOUT)!(Y["N")!$DATA(DUOUT)
GOTO END
IF $DATA(AG("ERR"))
GOTO VAR
+14 IF $DATA(DFOUT)!$DATA(DTOUT)
QUIT
+15 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG("N"))
WRITE !!,"You must enter a number from 1 to ",AG("N")
HANG 2
GOTO VAR
+16 SET AG("C")="ECNAME^AG8A,ECPH^AG8A,ECREL^AG8A,ECSTR^AG8A,ECCITY^AG8A,ECST^AG8A,ECZIP^AG8A,NKNAME^AG8B,NKPH^AG8B,NKREL^AG8B,NKSTR^AG8B,NKCITY^AG8B,NKST^AG8B,NKZIP^AG8B"
+17 SET AGY=Y
+18 FOR AGI=1:1
SET AG("SEL")=+$PIECE(AGY,",",AGI)
IF AG("SEL")<1!(AG("SEL")>AG("N"))
QUIT
DO @($PIECE(AG("C"),",",AG("SEL")))
+19 DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+20 KILL AGI,AGY
+21 GOTO VAR
END KILL AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y
+1 KILL ROUTID
+2 IF $DATA(AGXTERN)
QUIT
+3 IF $DATA(DIROUT)
QUIT
+4 IF $DATA(DUOUT)
GOTO ^AGED2
GOTO ^AGED4A
DRAW ;EP
+1 SET AG("PG")=3
+2 ;SET ROUTINE ID FOR PROGRAMMER VIEW
SET ROUTID=$PIECE($TEXT(+1)," ")
+3 SET DA=DFN
+4 DO ^AGED
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 WRITE !,"--- Emergency Contact Data "
FOR A=1:1:53
WRITE "-"
+7 FOR AG=1:1:14
Begin DoDot:1
+8 SET AGSCRN=$PIECE($TEXT(@1+AG),";;",2,15)
+9 SET DIC=$PIECE(AGSCRN,U,3)
+10 SET DR=$PIECE(AGSCRN,U,4)
+11 IF AG=8
WRITE !,"--- Next of Kin Data "
FOR A=1:1:59
WRITE "-"
+12 WRITE !,AG,".",?(29-$LENGTH($PIECE($GET(^DD(DIC,DR,0)),U))),$PIECE($GET(^DD(DIC,DR,0)),U)," : "
+13 WRITE $$GET1^DIQ(DIC,DFN,DR)
End DoDot:1
+14 WRITE !,AGLINE("-")
+15 KILL MYERRS,MYVARS
+16 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
+17 SET MYVARS("DFN")=DFN
SET MYVARS("FINDCALL")=""
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+18 DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
+19 QUIT
+20 ; ****************************************************************
+21 ; ON LINES BELOW:
+22 ; PIECE 1= FLD LBL
+23 ; PIECE 2= POSITION ON LINE TO DISP FLD
+24 ; PIECE 3= FILE #
+25 ; PIECE 4= FIELD #
1 ;
+1 ;;EMERGENCY CONTACT^5^2^.331
+2 ;;EC PHONE^14^2^.339
+3 ;;EC RELATIONSHIP^7^9000001^3102
+4 ;;EC ADDRESS-STREET^5^2^.333
+5 ;;EC ADDRESS-CITY^7^2^.336
+6 ;;EC ADDRESS-STATE^6^2^.337
+7 ;;EC ADDRESS-ZIP^8^2^.338
+8 ;;NEXT OF KIN^11^2^.211
+9 ;;NOK PHONE^13^2^.219
+10 ;;NOK RELATIONSHIP^6^9000001^2802
+11 ;;NOK ADDRESS-STREET^4^2^.213
+12 ;;NOK ADDRESS-CITY^6^2^.216
+13 ;;NOK ADDRESS-STATE^5^2^.217
+14 ;;NOK ADDRESS-ZIP^7^2^.218
