- 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
