AGED12.m

AGED12 ; IHS/ASDS/EFG - EDIT PAGE 12 ;  

 ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003

 I AGOPT(8)'="Y" G END

VAR D DRAW

L2 W !

 I $Y>8 W !,AGLINE("EQ")

 W !,"Do you wish to ",$S($Y>8:"edit",1:"add")," OTHER TRIBEs? (Y/N) NO// " D READ^AGED1

 Q:$D(DTOUT)!$D(DFOUT)

 G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))

 G EDIT:Y?1"Y".E,END:Y?1"N".E!$D(DLOUT)!$D(DUOUT) D YN^AG G L2

DRAW ; ENTRY POINT.

 S AG("PG")=12

 D ^AGED

 W !,AGLINE("EQ")

 Q:'$D(^AUPNPAT(DFN,43,0))  Q:+$P(^(0),U,4)<1

 W !!,"OTHER TRIBES:",?50,"QUANTUM:",!

 S DIC=9000001.43,DA=DFN F I=0:0 S I=$O(^AUPNPAT(DFN,43,I)) Q:+I'=I  S AG("DRENT1")=I,DR=.01 D ^AGDICLK I $D(AG("LKPRINT")) W !?5,AG("LKPRINT"),?53,$P(@AGL,U,2)

 Q

EDIT W !! S DIE="^AUPNPAT(",DR=4301,DA=DFN D ^DIE,UPDATE1^AGED(DUZ(2),DFN,12,"")

 I '$O(^AUPNPAT(DFN,43,0)) K ^AUPNPAT(DFN,43)

 G VAR

END K AG,DTOUT,DLOUT,DFOUT,DQOUT,DA,DIC,DIE,DR,AG("DRENT1"),AG("LKERR"),AG("LKPRINT")

AGED12    ; IHS/ASDS/EFG - EDIT PAGE 12 ;  

 +1       ;;7.0;IHS PATIENT REGISTRATION;;MAR 28, 2003

 +2        IF AGOPT(8)'="Y"

               GOTO END

VAR        DO DRAW

L2         WRITE !

 +1        IF $Y>8

               WRITE !,AGLINE("EQ")

 +2        WRITE !,"Do you wish to ",$SELECT($Y>8:"edit",1:"add")," OTHER TRIBEs? (Y/N) NO// "

           DO READ^AGED1

 +3        IF $DATA(DTOUT)!$DATA(DFOUT)

               QUIT 

 +4        IF $DATA(AG("ED"))&'$DATA(AGXTERN)

               GOTO @("^AGED"_AG("ED"))

 +5        IF Y?1"Y".E

               GOTO EDIT

           IF Y?1"N".E!$DATA(DLOUT)!$DATA(DUOUT)

               GOTO END

           DO YN^AG

           GOTO L2

DRAW      ; ENTRY POINT.

 +1        SET AG("PG")=12

 +2        DO ^AGED

 +3        WRITE !,AGLINE("EQ")

 +4        IF '$DATA(^AUPNPAT(DFN,43,0))

               QUIT 

           IF +$PIECE(^(0),U,4)<1

               QUIT 

 +5        WRITE !!,"OTHER TRIBES:",?50,"QUANTUM:",!

 +6        SET DIC=9000001.43

           SET DA=DFN

           FOR I=0:0

               SET I=$ORDER(^AUPNPAT(DFN,43,I))

               IF +I'=I

                   QUIT 

               SET AG("DRENT1")=I

               SET DR=.01

               DO ^AGDICLK

               IF $DATA(AG("LKPRINT"))

                   WRITE !?5,AG("LKPRINT"),?53,$PIECE(@AGL,U,2)

 +7        QUIT 

EDIT       WRITE !!

           SET DIE="^AUPNPAT("

           SET DR=4301

           SET DA=DFN

           DO ^DIE

           DO UPDATE1^AGED(DUZ(2),DFN,12,"")

 +1        IF '$ORDER(^AUPNPAT(DFN,43,0))

               KILL ^AUPNPAT(DFN,43)

 +2        GOTO VAR

END        KILL AG,DTOUT,DLOUT,DFOUT,DQOUT,DA,DIC,DIE,DR,AG("DRENT1"),AG("LKERR"),AG("LKPRINT")