AGCHTMP.m

AGCHTMP ; IHS/ASDS/EFG - ASSIGN A TEMPORARY CHART NUMBER ;  

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

QUES ;

 K AG("TEMP CHART")

 W !!!,"Do you need a temporary chart number for this new patient? (Y/N)  N// "

 D READ^AG

 S Y=$E(Y_"N")

 G END:$D(DUOUT)!$D(DTOUT)!$D(DFOUT)!(Y="N")

 I $D(DQOUT)!(Y'="Y") D  G QUES

 . W !!,"If you cannot give this patient an OFFICIAL chart number at"

 . W !," this time,",!,"answer ""YES"" to this question."

 S AGCH=999999

 S AGTCH=0

 F I=0:0 S AGCH=$O(^AUPNPAT("D",AGCH)) Q:AGCH=""  S AGTCH=AGCH

 S:AGTCH=0 AGTCH="T00000"

 S AGTCH=$E(AGTCH,2,6)

 S AGTCH=AGTCH+1

 S AGTCH="T"_$E(100000+AGTCH,2,6)

 S AG("TEMP CHART")=AGTCH

 W !!,"The new patient's TEMPORARY chart number is ",AG("TEMP CHART")

 W !!,"Press RETURN..."

 D READ^AG

END ;

 K AG("EDIT"),AGCH,AGTCH

 Q

AGCHTMP   ; IHS/ASDS/EFG - ASSIGN A TEMPORARY CHART NUMBER ;  

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

QUES      ;

 +1        KILL AG("TEMP CHART")

 +2        WRITE !!!,"Do you need a temporary chart number for this new patient? (Y/N)  N// "

 +3        DO READ^AG

 +4        SET Y=$EXTRACT(Y_"N")

 +5        IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DFOUT)!(Y="N")

               GOTO END

 +6        IF $DATA(DQOUT)!(Y'="Y")

               Begin DoDot:1

 +7                WRITE !!,"If you cannot give this patient an OFFICIAL chart number at"

 +8                WRITE !," this time,",!,"answer ""YES"" to this question."

               End DoDot:1

               GOTO QUES

 +9        SET AGCH=999999

 +10       SET AGTCH=0

 +11       FOR I=0:0

               SET AGCH=$ORDER(^AUPNPAT("D",AGCH))

               IF AGCH=""

                   QUIT 

               SET AGTCH=AGCH

 +12       IF AGTCH=0

               SET AGTCH="T00000"

 +13       SET AGTCH=$EXTRACT(AGTCH,2,6)

 +14       SET AGTCH=AGTCH+1

 +15       SET AGTCH="T"_$EXTRACT(100000+AGTCH,2,6)

 +16       SET AG("TEMP CHART")=AGTCH

 +17       WRITE !!,"The new patient's TEMPORARY chart number is ",AG("TEMP CHART")

 +18       WRITE !!,"Press RETURN..."

 +19       DO READ^AG

END       ;

 +1        KILL AG("EDIT"),AGCH,AGTCH

 +2        QUIT