- 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 ;
