ACHSFIM.m

ACHSFIM ;IHS/ITSC/JVK -AUTHORIZATION MESSAGE TO FI;

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,13**;JUN 11, 2001

 ;;ACHS*3.1*6 7/1/03 ADD THE ABLITY TO SEND APPROVAL AUTHORIZATION

 ;;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ Multiple fixes: exiting option, multiple looping, error on blanket, selecting special local type doc

 ;

EN ;EP - From Option to send approval message to FI

 ;

 I '$D(ACHSCFY)!($G(ACHSFC)="") D ^ACHSVAR

 ;

 K DR,D0,D1,D2,ACHSDIEN

 ;

 D ^ACHSUD              ;SELECT DOCUMENT AND DISPLAY

 I '$D(ACHSDIEN) D K Q

 S %=$$DOC^ACHS(0,12) ;TEST FOR OPEN DOCUMENT

 I %'=0 W !,"Must be an open document." D K G EN

 K DIR

 ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ ADDED NXT 2 LINES

 S %=$$DOC^ACHS(0,3) ;TEST FOR SPECIAL LOCAL DOCUMENT

 I %=2 W !!,"Cannot send a special local document." D K K DIR G EN

 D DISPLAY

ASK ;

 S %=$$DIR^ACHS("Y","Do you want to send a EPO approval message to the FI","YES","By entering yes you may send approval for sterilization procedures,etc","","")

 I Y<1 D K Q

 D SET

 ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ  ADD NXT 4 LINES AND "SET" SUB

 ;G ASK

 S %=$$DIR^ACHS("Y","Do you want to send another EPO approval message to the FI","YES","By entering yes you may send approval for sterilization procedures,etc","","")

 I Y=1 D SET

 W !!,"Approval Message will be sent with next export to the FI ONLY if PO has not been exported",!

 D RTRN^ACHS D K Q

 ;

SET ;SET MESSAGE IN DOCUMENT

 S %=$$DIE^ACHS(102,.01)

 D DISPLAY

 Q

 ;

DISPLAY ;

 W @IOF

 W !

 W ?5,"DOCUMENT: ",$$DOC^ACHS(0,14)_"-"_$$DOC^ACHS(0,1)

 ;W ?40,"PATIENT NAME: ",$P(^DPT($$DOC^ACHS(0,22),0),U),!

 W:$$DOC^ACHS(0,3)'=1 ?40,"PATIENT NAME: ",$P(^DPT($$DOC^ACHS(0,22),0),U)

 S ACHSDOS=$$DOC^ACHS(3,1)

 S Y=ACHSDOS D DD^%DT S ACHSDOS=Y

 W !?5,"DATE OF SERVICE: ",ACHSDOS

 Q:'$D(^ACHSF(DUZ(2),"D",ACHSDIEN,102))  ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ

 W ?40,"APRROVAL MESSAGE(S) TO FI: ",!

 S J=0

 F I=1:1:2  S J=$O(^ACHSF(DUZ(2),"D",ACHSDIEN,102,J)) Q:J'?1N.N  D

 . S ACHSVAL(I)=$P(^ACHSF(DUZ(2),"D",ACHSDIEN,102,J,0),U)

 . W ?49,I_". "_$S(ACHSVAL(I)="S":"Sterilization",ACHSVAL(I)="D":"In Support of Direct Care",ACHSVAL(I)="":""),!

 Q

K ;

 K ACHSDIEN,ACHSDOS,ACHSVAL,D0,D1,I,J

 Q

 ;

ACHSFIM   ;IHS/ITSC/JVK -AUTHORIZATION MESSAGE TO FI;

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**6,13**;JUN 11, 2001

 +2       ;;ACHS*3.1*6 7/1/03 ADD THE ABLITY TO SEND APPROVAL AUTHORIZATION

 +3       ;;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ Multiple fixes: exiting option, multiple looping, error on blanket, selecting special local type doc

 +4       ;

EN        ;EP - From Option to send approval message to FI

 +1       ;

 +2        IF '$DATA(ACHSCFY)!($GET(ACHSFC)="")

               DO ^ACHSVAR

 +3       ;

 +4        KILL DR,D0,D1,D2,ACHSDIEN

 +5       ;

 +6       ;SELECT DOCUMENT AND DISPLAY

           DO ^ACHSUD

 +7        IF '$DATA(ACHSDIEN)

               DO K

               QUIT 

 +8       ;TEST FOR OPEN DOCUMENT

           SET %=$$DOC^ACHS(0,12)

 +9        IF %'=0

               WRITE !,"Must be an open document."

               DO K

               GOTO EN

 +10       KILL DIR

 +11      ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ ADDED NXT 2 LINES

 +12      ;TEST FOR SPECIAL LOCAL DOCUMENT

           SET %=$$DOC^ACHS(0,3)

 +13       IF %=2

               WRITE !!,"Cannot send a special local document."

               DO K

               KILL DIR

               GOTO EN

 +14       DO DISPLAY

ASK       ;

 +1        SET %=$$DIR^ACHS("Y","Do you want to send a EPO approval message to the FI","YES","By entering yes you may send approval for sterilization procedures,etc","","")

 +2        IF Y<1

               DO K

               QUIT 

 +3        DO SET

 +4       ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ  ADD NXT 4 LINES AND "SET" SUB

 +5       ;G ASK

 +6        SET %=$$DIR^ACHS("Y","Do you want to send another EPO approval message to the FI","YES","By entering yes you may send approval for sterilization procedures,etc","","")

 +7        IF Y=1

               DO SET

 +8        WRITE !!,"Approval Message will be sent with next export to the FI ONLY if PO has not been exported",!

 +9        DO RTRN^ACHS

           DO K

           QUIT 

 +10      ;

SET       ;SET MESSAGE IN DOCUMENT

 +1        SET %=$$DIE^ACHS(102,.01)

 +2        DO DISPLAY

 +3        QUIT 

 +4       ;

DISPLAY   ;

 +1        WRITE @IOF

 +2        WRITE !

 +3        WRITE ?5,"DOCUMENT: ",$$DOC^ACHS(0,14)_"-"_$$DOC^ACHS(0,1)

 +4       ;W ?40,"PATIENT NAME: ",$P(^DPT($$DOC^ACHS(0,22),0),U),!

 +5        IF $$DOC^ACHS(0,3)'=1

               WRITE ?40,"PATIENT NAME: ",$PIECE(^DPT($$DOC^ACHS(0,22),0),U)

 +6        SET ACHSDOS=$$DOC^ACHS(3,1)

 +7        SET Y=ACHSDOS

           DO DD^%DT

           SET ACHSDOS=Y

 +8        WRITE !?5,"DATE OF SERVICE: ",ACHSDOS

 +9       ;ACHS*3.1*13 6.6.2007 OIT/DIRM/FCJ

           IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN,102))

               QUIT 

 +10       WRITE ?40,"APRROVAL MESSAGE(S) TO FI: ",!

 +11       SET J=0

 +12       FOR I=1:1:2

               SET J=$ORDER(^ACHSF(DUZ(2),"D",ACHSDIEN,102,J))

               IF J'?1N.N

                   QUIT 

               Begin DoDot:1

 +13               SET ACHSVAL(I)=$PIECE(^ACHSF(DUZ(2),"D",ACHSDIEN,102,J,0),U)

 +14               WRITE ?49,I_". "_$SELECT(ACHSVAL(I)="S":"Sterilization",ACHSVAL(I)="D":"In Support of Direct Care",ACHSVAL(I)="":""),!

               End DoDot:1

 +15       QUIT 

K         ;

 +1        KILL ACHSDIEN,ACHSDOS,ACHSVAL,D0,D1,I,J

 +2        QUIT 

 +3       ;