APCDPAUT.m

APCDPAUT ; IHS/CMI/LAB - LOOKUP UP V CHS BY AUTHORIZATION ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 W !!,"This routine will find and display a V CHS entry for a given",!,"Authorization Number.",!!

READ ;

 K DIR S (APCDX,APCDY)=""

 S DIR("?")="   "

 S DIR("?",1)="The number entered must be a 10 digit Authorization Number in the form:",DIR("?",2)="   2 digit FY, then a 3 digit alphanumeric location code, then a 5 digit number.",DIR("?",3)="   For example:  8700112345"

 S DIR(0)="F^10:10",DIR("A")="Enter an Authorization Number" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) XIT

 I Y'?2N3AN5N W $C(7),$C(7),!!,DIR("?",1),!,DIR("?",2),!,DIR("?",3) G READ

 K DIR

PROCESS ;

 S APCDY=Y

 S APCDN=$O(^AUPNVCHS("AUTHNO",APCDY,""))

 I APCDN="" W !!,$C(7),$C(7),"That Authorization Number has not been used, Please re-enter",! G READ

 I '$D(^AUPNVCHS(APCDN)) W !,$C(7),$C(7),"ERROR in Authorization Number Cross Reference -- Notify your supervisor",!!

 W !!,"This CHS entry has been entered with Authorization Number ",APCDY,!!

 S DA=APCDN,DR=0,DIC="^AUPNVCHS(" D EN^DIQ

 ;

 S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

XIT ;

 K DIRUT,DUOUT,DIR,DTOUT

 K APCDY,APCDX,APCDN

 Q

APCDPAUT  ; IHS/CMI/LAB - LOOKUP UP V CHS BY AUTHORIZATION ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3        WRITE !!,"This routine will find and display a V CHS entry for a given",!,"Authorization Number.",!!

READ      ;

 +1        KILL DIR

           SET (APCDX,APCDY)=""

 +2        SET DIR("?")="   "

 +3        SET DIR("?",1)="The number entered must be a 10 digit Authorization Number in the form:"

           SET DIR("?",2)="   2 digit FY, then a 3 digit alphanumeric location code, then a 5 digit number."

           SET DIR("?",3)="   For example:  8700112345"

 +4        SET DIR(0)="F^10:10"

           SET DIR("A")="Enter an Authorization Number"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +5        IF $DATA(DIRUT)

               GOTO XIT

 +6        IF Y'?2N3AN5N

               WRITE $CHAR(7),$CHAR(7),!!,DIR("?",1),!,DIR("?",2),!,DIR("?",3)

               GOTO READ

 +7        KILL DIR

PROCESS   ;

 +1        SET APCDY=Y

 +2        SET APCDN=$ORDER(^AUPNVCHS("AUTHNO",APCDY,""))

 +3        IF APCDN=""

               WRITE !!,$CHAR(7),$CHAR(7),"That Authorization Number has not been used, Please re-enter",!

               GOTO READ

 +4        IF '$DATA(^AUPNVCHS(APCDN))

               WRITE !,$CHAR(7),$CHAR(7),"ERROR in Authorization Number Cross Reference -- Notify your supervisor",!!

 +5        WRITE !!,"This CHS entry has been entered with Authorization Number ",APCDY,!!

 +6        SET DA=APCDN

           SET DR=0

           SET DIC="^AUPNVCHS("

           DO EN^DIQ

 +7       ;

 +8        SET DIR(0)="E"

           SET DIR("A")="Press Enter to Continue"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

XIT       ;

 +1        KILL DIRUT,DUOUT,DIR,DTOUT

 +2        KILL APCDY,APCDX,APCDN

 +3        QUIT