AGEDBEC ; IHS/ASDS/TPF - EDIT/DISPLAY BENEFITS COORDINATOR - AUTHORIZATIONS SCREEN ;
;;7.1;PATIENT REGISTRATION;**2,4**;JAN 31, 2007
;
;AD0 AND AD1 WILL BE THE IENS NEEDED TO DISP THE PRIOR AUTH
;WHICH WAS CHOSEN FROM THE BEN COORD MAIN SCREEN (^AGEDBEA)
;IF THIS IS A NEW ENTRY THE USER WILL BE ASKED WHAT TYPE IP/OP
EN(AD0,AD1,NEWENTRY) ;
;IF ITS A NEW ENTRY,DISP THE SCREEN,DISP A MESSAGE,THEN CALL THE
;EDITS TO FLDS APPROPRIATE FOR ADDING A NEW ENTRY
S EXIT=0
I NEWENTRY D DRAW,WMSG,NEWENTRY D:$G(Y)<0 BADENTRY Q:EXIT D EDINSNAM,EDPRCERT,EDCRTNUM
I NEWENTRY,$P($G(^AUPNAUTH(AD0,11,AD1,0)),U,3)="OP" D EDSRVCAT,EDAUTHVS S NEWENTRY=0 G VAR
I NEWENTRY,$P($G(^AUPNAUTH(AD0,11,AD1,0)),U,3)="IP" D EDADMDT,EDAUTHDY S NEWENTRY=0
VAR D DRAW
;Q:$D(AGSEENLY)
W !,AGLINE("EQ")
K DIR
I '$D(AGSEENLY) D
.S DIR("A")="Change which item (1-"_AG("N")_") OR Add <A>dditional "_$S($G(TYPEFLAG)="DAYS":"Days",1:"Visits")_" or <C>ontacts"
I $D(AGSEENLY) D
.S:AG("N")>8 DIR("A")="Enter item number to view"
.S:AG("N")<9 DIR("A")="Press return to continue"
.S DIR="LO^1:"_AG("N")
D READ^AGED1
I $D(AGSEENLY),(Y=12) D DISNOTES G VAR
I $D(AGSEENLY),(+Y'>0) Q
I $D(AGSEENLY),((Y<10)!(Y>AG("N"))) W !,"Enter a number between 9 and "_AG("N") H 2 G VAR
I $D(MYERRS("C","E")),(Y'?1N.N),(Y'="E") W !,"ERRORS ON THIS PAGE. PLEASE EDIT BEFORE EXITING!!" H 3 G VAR
Q:Y=$G(AGOPT("ESCAPE"))
;DO RTNS TO ADD ENTRY
I $G(Y)="A"!($G(Y)="C") D @$S(Y="A":"EN^AGEDBEF("_AD0_","_AD1_","""",1)",1:"EN^AGEDBEG("_AD0_","_AD1_","""",1)") G VAR
G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))
Q:$D(DFOUT)!$D(DTOUT)
I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N"),!,"or 'A' to add additional days authorized,",!,"or 'C' to add contact information." H 3 G VAR
;DEPENDING ON USER'S CHOICE, ITEM MAY BE AN EDIT ON THIS SCREEN OR
;IT MAY BE A PATIENT APPLICATION WHICH IS ON ^AGEDBED
I $D(CHOICES(+Y)) D G VAR
.S DORTN=$S($P(CHOICES(+Y),U)["1201":"EN^AGEDBEF",1:"EN^AGEDBEG")
.S PARAM1=$P(CHOICES(+Y),U,2)
.S PARAM2=$P(CHOICES(+Y),U,3)
.S PARAM3=$P(CHOICES(+Y),U,4)
.S DORTN=DORTN_"("_PARAM1_","_PARAM2_","_PARAM3_","_"0)"
.D @DORTN
I +$G(Y) D
.S AGY=Y
.F AGI=1:1 S AG("SEL")=+$P(AGY,",",AGI) Q:AG("SEL")<1!(AG("SEL")>AG("N")) Q:$P(AG("C"),",",AG("SEL"))="" D @($P(AG("C"),",",AG("SEL")))
;THEY HAVE DELETED THE AUTH. ENCOUNTER DT
;THEY CHOSE TO ENTER THIS SCREEN. IT IS GONE
;SO RETURN TO MAIN SCREEN
I AGY=1,'$D(^AUPNAUTH(AD0,11,AD1)) D CLEAN(AD0) Q
D CLEAN(AD0) I '$D(^AUPNAUTH(AD0)) Q
;D UPDATE1^AGED(DUZ(2),DFN,3,"")
I '$D(AGSEENLY) D UPDATE1^AGED(DUZ(2),DFN,3,"") ;AG*7.1*2 REPORTED DURING ALPHA
K AGI,AGY
G VAR
CLEAN(AD0) ;CLEAN EMPTY RECORD. IF NO BEN COORD DATES HAVE BEEN
;ENTERED THE RECORD IS MEANINGLES
;
;CHECK HERE TO SEE IF ENTRIES HAVE ACTUALLY BEEN ENTERED. IF NOT
;CLEAR THE TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS IN THIS RECORD
I $O(^AUPNAUTH(AD0,11,0))="" D
.D CLEANZER(AD0)
.W !,"RECORD DELETED!" H 3
Q
CLEANZER(AD0) ;EP
K DIK,DA
S DIK="^AUPNAUTH(",DA=AD0 D ^DIK
Q
BADENTRY ;EP
S EXIT=1
W !,"Entry not made." H 2 D END Q
Q
END ;CLEAN UP THE VARS USED
K AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC,NEWENTRY
K ROUTID
Q
DRAW ;EP
K CHOICES
S ROUTID=$P($T(+1)," ")
S AG("PG")="5BEC"
D ^AGED
D GETAW
Q
GETAW ;DISP
K AG("C")
;S ITEM=9
S ITEM=8 ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
F AG=1:1 D Q:$G(AGSCRN)[("*END*")
. S AGSCRN=$P($T(@1+AG),";;",2,15)
. Q:AGSCRN[("*END*")
. S CAPTION=$P(AGSCRN,U) ;FLD CAP
. I $E(CAPTION)="-" D CAPPARSE(CAPTION) Q ;PARSE OUT CAP
. S DIC=$P(AGSCRN,U,3) ;FILE OR SUBFILE #
. S DR=$P(AGSCRN,U,4) ;FLD #
. S SKIPEXEC=$P(AGSCRN,"|",6) ;SKIP LOGIC. IF THIS IS TRUE WE
. ; DON'T DEAL WITH THIS FLD AT ALL
. I SKIPEXEC'="" X SKIPEXEC Q:$T
. S NEWLINE=$P(AGSCRN,U,5) ;NEWLINE OR INDENT
. S CAPDENT=$P(AGSCRN,U,2) ;CAP INDENT
. S ITEMNUM=$P(AGSCRN,U,6) ;ITEM #
. S TAGCALL=$P($P(AGSCRN,U,7),"|",1) ;TAG TO CALL TO EDIT THIS FLD
. S EXECUTE=$P(AGSCRN,"|",2) ;USE TO DISP FLD WHICH IS DEPENDENT ON OTHER FLD
. S PREEXEC=$P(AGSCRN,"|",3) ;PLACE CODE TO BE XECUTED PRIOR TO DISP OF THE FLD
. S PRECAPEX=$P(AGSCRN,"|",4) ;PLACE CODE TO EXECUTE BEF CAP/FLD LBL
. S POSTEXEC=$P(AGSCRN,"|",5) ;PLACE CODE HERE TO BE EXECUTED AFT DISP OF THE FLD
. S:TAGCALL'="" $P(AG("C"),",",ITEMNUM)=TAGCALL ;SELECTION STRING
. W @NEWLINE
. W ITEMNUM
. W $S(ITEMNUM'="":". ",1:"")
. I PRECAPEX="" W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
. I PRECAPEX'="" X PRECAPEX I $T W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,DR,0)),U)_": ")
.;IF EDITING,DISP DATA
.;E DISP ONLY THE CAPS
.I 'NEWENTRY D
.. S D0=AD0
.. I DIC'["." S D0=D0_","
.. E S D0=AD1_","_D0_","
.. ;LOOP TO HANDLE MULTIPLE DR'S FOR ONE CAP
.. N PIECE
.. S VDR=DR
.. F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR="" D
... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
... I $P(EXECUTE,";",PIECE)="" D
.... I DR=.08,(DIC=9000046.11),($$GET1^DIQ(DIC,D0,DR)'="") W $J($$GET1^DIQ(DIC,D0,DR),10,2) Q ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
.... I DR=.09,(DIC=9000046.11),($$GET1^DIQ(DIC,D0,DR)'="") W $E($$GET1^DIQ(DIC,D0,DR),1,20) Q ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
.... E W $$GET1^DIQ(DIC,D0,DR)
... I $P(EXECUTE,";",PIECE)'="" S D0=$TR(D0,",") X $P(EXECUTE,";",PIECE)
... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
..K PIECE
..;LIST ADDITIONAL DAYS AUTHORIZED
.. I DIC[".1201"!(DIC[".1101") D
... S SUBSCRIP=$S(DIC[".1201":2,1:1)
... S VD0=AD0
... S VD1=AD1
... I DIC[".1101",'$D(^AUPNAUTH(VD0,11,VD1,SUBSCRIP)) W !,"***NO AUTH. ENCOUNTER CONTACTS***" Q
... I DIC[".1201",'$D(^AUPNAUTH(VD0,11,VD1,SUBSCRIP)) W !,"***NO ADDITIONAL "_$G(TYPEFLAG)_" AUTHORIZED***" Q
... S VD2=0
... F S VD2=$O(^AUPNAUTH(VD0,11,VD1,SUBSCRIP,VD2)) Q:'VD2 D
.... S ITEM=ITEM+1
.... S CHOICES(ITEM)=DIC_U_VD0_U_VD1_U_VD2
.... S D0=VD2_","_VD1_","_VD0_","
.... I ITEM=1 W ?0,ITEM_"."
.... E W !,ITEM_"."
.... N PIECE
.... F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR="" D
..... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
..... I $P(EXECUTE,";",PIECE)="" D
...... W $S(DR=.02:$E($$GET1^DIQ(DIC,D0,DR),1,15),DR=.04:$E($$GET1^DIQ(DIC,D0,DR),1,19),1:$$GET1^DIQ(DIC,D0,DR))
..... I $P(EXECUTE,";",PIECE)'="" X $P(EXECUTE,";",PIECE)
..... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
....K PIECE
..;LIST WORD PROCESSING FLDS
..I DIC["9000046.1301" D
...S ITEM=ITEM+1
...W !,ITEM_". NOTES: "
...S $P(AG("C"),",",ITEM)="EDENCNOT"
...K ^UTILITY($J,"W")
...S DIWL=12,DIWR=75
...S DIWF="WC65|"
...S VD0=AD0
...S VD1=AD1
...S VD2=0
...F S VD2=$O(^AUPNAUTH(VD0,11,VD1,3,VD2)) Q:'VD2 D
....S X=$G(^AUPNAUTH(VD0,11,VD1,3,VD2,0))
....D ^DIWP
...D ^DIWW
S AG("N")=$G(ITEM)
K MYERRS,MYVARS
D FETCHERR^AGEDERR(AG("PG"),.MYERRS)
S MYVARS("DFN")=DFN,MYVARS("FINDCALL")="",MYVARS("SELECTION")=$G(AGSELECT),MYVARS("SITE")=DUZ(2)
D EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
W $G(AGLINE("-"))
D VERIF^AGUTILS
Q
CAPPARSE(CAPTION) ;EP - PARSE OUT THE CAP
N LBRACKET,RBRACKET,EXEC
S LBRACKET="[",RBRACKET="]"
I CAPTION'[LBRACKET W !,$E(CAPTION,2,199) Q ;- DENOTES SIMPLE SECTION
;PARSE OUT AND INSERT FLD VALUES
S FIELDS=$L(CAPTION,LBRACKET)
W !,$E($P(CAPTION,LBRACKET),2,199)
F PIECE=1:1:FIELDS D
.S FIELD=$P($P(CAPTION,LBRACKET,PIECE),RBRACKET)
.I $P(FIELD,";",3)="" W $$GET1^DIQ($P(FIELD,";"),AD1_","_AD0_",",$P(FIELD,";",2))
.I $P(FIELD,";",3)'="" S EXEC=$P(FIELD,";",3) D
..S X=$$GET1^DIQ($P(FIELD,";"),AD1_","_AD0_",",$P(FIELD,";",2),"I") X EXEC
W $P(CAPTION,RBRACKET,2)
K LBRACKET,RBRACKET,EXEC
Q
WMSG ;DISP THIS MSG IF THERE IS NO AUTHORIZATION DT FOUND
W !,"You must first enter a AUTHORIZATION DATE"
Q
;;;;;;;;;;;;;;;;;;;;;;;;;
; EDIT AUTHORIZATION FLDS
;;;;;;;;;;;;;;;;;;;;;;;;;
NEWENTRY ;NEW ENTRY
W !!
K DIC,DIE,DR,DA
S DIC="^AUPNAUTH("
S DIC(0)="L"
S DIC("S")="I $G(Y)'=TEMPDFN"
S X="`"_DFN
S TEMPDFN=DFN
D ^DIC
S DFN=TEMPDFN
Q:+Y'>0
S AD0=+Y
NEWENCDT ;ENTER NEW ENCOUNTER DT
K DIC,DIE,DR,DA
S DA(1)=AD0
S DIC="^AUPNAUTH("_DA(1)_",11,"
S DIC(0)="ALMEQ"
K DD,DO
D ^DIC
Q:+Y'>0
S AD1=+Y
EDENTYPE ;EDIT ENCOUNTER TYPE
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=".03R",DIE("NO^")=""
D ^DIE
K DIC,DR,DIE,DA
Q
EDENCDT ;EDIT ENCOUNTER DT
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=".01"
D ^DIE
K DIC,DR,DIE,DA
Q
EDINSNAM ;EP - EDIT INSURANCE COMPANY
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=.04
D ^DIE
K DIC,DR,DIE,DA
Q
EDPRCERT ;EP - EDIT PRE-CERT DT
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=".05"
D ^DIE
K DIC,DR,DIE,DA
I $P($G(^AUPNAUTH(AD0,11,AD1,0)),U,5) D EDAUTHST
Q
EDCRTNUM ;EDIT PRE-CERT #
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=.06
D ^DIE
K DIC,DR,DIE,DA
Q
EDADMDT ;EDIT ADMISSION DT
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=.02
D ^DIE
K DIC,DR,DIE,DA
Q
EDAUTHDY ;EDIT AUTHORIZED DAYS
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=.07
D ^DIE
K DIC,DR,DIE,DA
Q
EDMAXDOL ;EDIT MAX DOLLARS
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD0
S DA=AD1
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=.08
D ^DIE
K DIC,DR,DIE,DA
Q
EDSRVCAT ;EDIT SERVICE CATEGORY
K DIC,DR,DIE,DA,DD,DO
S DA=AD1
S DA(1)=AD0
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=".09"
D ^DIE
K DIC,DR,DIE,DA
Q
EDAUTHVS ;EDIT AUTHORIZED VISITS
K DIC,DR,DIE,DA,DD,DO
S DA=AD1
S DA(1)=AD0
S DIE="^AUPNAUTH("_DA(1)_",11,"
S DR=".11"
D ^DIE
K DIC,DR,DIE,DA
Q
EDAUTHST ;EDIT AUTHORIZATION STATUS
K DIC,DR,DIE,DA,DD,DO
S DA=AD1
S DA(1)=AD0
S DIE="^AUPNAUTH("_DA(1)_",11,"
;IF PRE-CERT DT, MAKE AUTH STATUS REQUIRED
I $P($G(^AUPNAUTH(AD0,11,AD1,0)),U,5) S DR=".12R",DIE("NO^")=""
E S DR=".12"
D ^DIE
K DIC,DR,DIE,DA
Q
EDENCNOT ;EDIT ENCOUNTER NOTES
K DIC,DR,DIE,DA,DD,DO
S DA(1)=AD1
S DA(2)=AD0
S DIC="^AUPNAUTH("_DA(2)_",11,"_DA(1)_",3,"
D EN^DIWE
K DIC,DR,DIE,DA
Q
;USED ONLY FOR VIEW OPTION
DISNOTES ;EP
I '$D(^AUPNAUTH(AD0,11,AD1,3)) W !,"NO NOTES TO VIEW" H 2 Q
N LN,X
S LN=0
W !!
F S LN=$O(^AUPNAUTH(AD0,11,AD1,3,LN)) Q:'LN D
.S X=$G(^AUPNAUTH(AD0,11,AD1,3,LN,0))
.D ^DIWP
D ^DIWW
K DIR S DIR(0)="E" D ^DIR
Q
; ****************************************************************
; ON LINES BELOW:
; U "^" DELIMITED
; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
; PIECE VAR DESC
; ----- -------- -----------------------------------------------
; 1 CAPTION FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LBL IF POPULATED
; 2 CAPDENT POS ON LINE TO DISP CAP
; 3 DIC FILE OR SUBFILE #
; 4 DR FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
; MULTIPLE FLDS TO BE PRINTED WITH THE SAME CAP AS IN
; 'CITY,STATE,ZIP'
; 5 NEWLINE NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#')
; USE THIS TO INDENT THE LINE
; 6 ITEMNUM ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM #
; USED TO ALLOW USER TO CHOOSE THIS FLD TO EDIT
; 7 TAGCALL TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO BE EDITED
;
; BAR "|" DELIMITED
; PIECE VAR DESC
; ----- -------- ----------------------------------------------
; 2 EXECUTE EXECUTE CODE TO GET FLD THAT OTHER IS POINTING TO.
; EXECUTED AFT FLD PRINT. IF MUTL FILEDS ARE PRINTED
; THEN MULTIPLE EXECUTE CODES CAN BE SEPARATED BY ";".
; 3 PREEXEC EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
; PRINTING A FIELD VALUE. FOR MULTIPLES SEPARATE BY ";"
; 4 PRECAPEX EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
; USE TO SCREEN OUT PRINTING A CAP/FLD LBL
; 5 POSTEXEC EXECUTE CODE TO DO AFT PRINTING THE FLD DATA
; FOR MULTIPLES SEPARATE BY ";"
; 6 SKIPEXEC EXECUTE CODE TO SKIP ENTIRE FLD
;
1 ;
;;- BENEFITS COORDINATION
;;--[9000046.11;.03] - PRIOR AUTHORIZATIONS----------------------------------------------
;;Auth. Encounter Date^?0^9000046.11^.01^!^1^EDENCDT
;;Insurance Name^?0^9000046.11^.04^!^2^EDINSNAM
;;Pre-Auth Date^?0^9000046.11^.05^!^3^EDPRCERT
;;Pre-Auth Number^?0^9000046.11^.06^?45^4^EDCRTNUM
;;Admission Date^?0^9000046.11^.02^!^5^EDADMDT|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
;;Authorized Days^?0^9000046.11^.07^?45^6^EDAUTHDY|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
;;Max Dollar....^?0^9000046.11^.08^!^7^EDMAXDOL|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
;;Service Category^?0^9000046.11^.09^!^5^EDSRVCAT|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="OP"
;;Authorized Visits^?0^9000046.11^.11^?45^6^EDAUTHVS|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="OP"
;;Authorization Status^?0^9000046.11^.12^!^8^EDAUTHST
;;-
;;--CONTACT DATES------------------------------------------------------------------
;;-CONTACT DATE CONTACT PERSON PHONE FAX E-MAIL
;;---------------------------------------------------------------------------------
;;^?0^9000046.1101^.01;.02;.03;.05;.04^?0^^||;W ?17;W ?35;W ?50;W ?60
;;-
;;--REQUEST FOR ADDITIONAL [9000046.11;.03;S TYPEFLAG=$S(X="OP":"VISITS",1:"DAYS") W TYPEFLAG] -------------------------------------------------
;;-Date Obtained Reference # Additional [9000046.11;.03;W $S(X="OP":"VISITS",1:"DAYS")] Authorized
;;---------------------------------------------------------------------------------
;;^?0^9000046.1201^.01;.02;.07;.08^?0^^||;W ?25;W ?55
;;---------------------------------------------------------------------------------
;;^?0^9000046.1301^.01^?0^^EDENCNOT
;;*END*
AGEDBEC ; IHS/ASDS/TPF - EDIT/DISPLAY BENEFITS COORDINATOR - AUTHORIZATIONS SCREEN ;
+1 ;;7.1;PATIENT REGISTRATION;**2,4**;JAN 31, 2007
+2 ;
+3 ;AD0 AND AD1 WILL BE THE IENS NEEDED TO DISP THE PRIOR AUTH
+4 ;WHICH WAS CHOSEN FROM THE BEN COORD MAIN SCREEN (^AGEDBEA)
+5 ;IF THIS IS A NEW ENTRY THE USER WILL BE ASKED WHAT TYPE IP/OP
EN(AD0,AD1,NEWENTRY) ;
+1 ;IF ITS A NEW ENTRY,DISP THE SCREEN,DISP A MESSAGE,THEN CALL THE
+2 ;EDITS TO FLDS APPROPRIATE FOR ADDING A NEW ENTRY
+3 SET EXIT=0
+4 IF NEWENTRY
DO DRAW
DO WMSG
DO NEWENTRY
IF $GET(Y)<0
DO BADENTRY
IF EXIT
QUIT
DO EDINSNAM
DO EDPRCERT
DO EDCRTNUM
+5 IF NEWENTRY
IF $PIECE($GET(^AUPNAUTH(AD0,11,AD1,0)),U,3)="OP"
DO EDSRVCAT
DO EDAUTHVS
SET NEWENTRY=0
GOTO VAR
+6 IF NEWENTRY
IF $PIECE($GET(^AUPNAUTH(AD0,11,AD1,0)),U,3)="IP"
DO EDADMDT
DO EDAUTHDY
SET NEWENTRY=0
VAR DO DRAW
+1 ;Q:$D(AGSEENLY)
+2 WRITE !,AGLINE("EQ")
+3 KILL DIR
+4 IF '$DATA(AGSEENLY)
Begin DoDot:1
+5 SET DIR("A")="Change which item (1-"_AG("N")_") OR Add <A>dditional "_$SELECT($GET(TYPEFLAG)="DAYS":"Days",1:"Visits")_" or <C>ontacts"
End DoDot:1
+6 IF $DATA(AGSEENLY)
Begin DoDot:1
+7 IF AG("N")>8
SET DIR("A")="Enter item number to view"
+8 IF AG("N")<9
SET DIR("A")="Press return to continue"
+9 SET DIR="LO^1:"_AG("N")
End DoDot:1
+10 DO READ^AGED1
+11 IF $DATA(AGSEENLY)
IF (Y=12)
DO DISNOTES
GOTO VAR
+12 IF $DATA(AGSEENLY)
IF (+Y'>0)
QUIT
+13 IF $DATA(AGSEENLY)
IF ((Y<10)!(Y>AG("N")))
WRITE !,"Enter a number between 9 and "_AG("N")
HANG 2
GOTO VAR
+14 IF $DATA(MYERRS("C","E"))
IF (Y'?1N.N)
IF (Y'="E")
WRITE !,"ERRORS ON THIS PAGE. PLEASE EDIT BEFORE EXITING!!"
HANG 3
GOTO VAR
+15 IF Y=$GET(AGOPT("ESCAPE"))
QUIT
+16 ;DO RTNS TO ADD ENTRY
+17 IF $GET(Y)="A"!($GET(Y)="C")
DO @$SELECT(Y="A":"EN^AGEDBEF("_AD0_","_AD1_","""",1)",1:"EN^AGEDBEG("_AD0_","_AD1_","""",1)")
GOTO VAR
+18 IF $DATA(DLOUT)!(Y["N")!$DATA(DUOUT)
GOTO END
IF $DATA(AG("ERR"))
GOTO VAR
+19 IF $DATA(DFOUT)!$DATA(DTOUT)
QUIT
+20 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG("N"))
WRITE !!,"You must enter a number from 1 to ",AG("N"),!,"or 'A' to add additional days authorized,",!,"or 'C' to add contact information."
HANG 3
GOTO VAR
+21 ;DEPENDING ON USER'S CHOICE, ITEM MAY BE AN EDIT ON THIS SCREEN OR
+22 ;IT MAY BE A PATIENT APPLICATION WHICH IS ON ^AGEDBED
+23 IF $DATA(CHOICES(+Y))
Begin DoDot:1
+24 SET DORTN=$SELECT($PIECE(CHOICES(+Y),U)["1201":"EN^AGEDBEF",1:"EN^AGEDBEG")
+25 SET PARAM1=$PIECE(CHOICES(+Y),U,2)
+26 SET PARAM2=$PIECE(CHOICES(+Y),U,3)
+27 SET PARAM3=$PIECE(CHOICES(+Y),U,4)
+28 SET DORTN=DORTN_"("_PARAM1_","_PARAM2_","_PARAM3_","_"0)"
+29 DO @DORTN
End DoDot:1
GOTO VAR
+30 IF +$GET(Y)
Begin DoDot:1
+31 SET AGY=Y
+32 FOR AGI=1:1
SET AG("SEL")=+$PIECE(AGY,",",AGI)
IF AG("SEL")<1!(AG("SEL")>AG("N"))
QUIT
IF $PIECE(AG("C"),",",AG("SEL"))=""
QUIT
DO @($PIECE(AG("C"),",",AG("SEL")))
End DoDot:1
+33 ;THEY HAVE DELETED THE AUTH. ENCOUNTER DT
+34 ;THEY CHOSE TO ENTER THIS SCREEN. IT IS GONE
+35 ;SO RETURN TO MAIN SCREEN
+36 IF AGY=1
IF '$DATA(^AUPNAUTH(AD0,11,AD1))
DO CLEAN(AD0)
QUIT
+37 DO CLEAN(AD0)
IF '$DATA(^AUPNAUTH(AD0))
QUIT
+38 ;D UPDATE1^AGED(DUZ(2),DFN,3,"")
+39 ;AG*7.1*2 REPORTED DURING ALPHA
IF '$DATA(AGSEENLY)
DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+40 KILL AGI,AGY
+41 GOTO VAR
CLEAN(AD0) ;CLEAN EMPTY RECORD. IF NO BEN COORD DATES HAVE BEEN
+1 ;ENTERED THE RECORD IS MEANINGLES
+2 ;
+3 ;CHECK HERE TO SEE IF ENTRIES HAVE ACTUALLY BEEN ENTERED. IF NOT
+4 ;CLEAR THE TOP LEVEL RECORD SINCE NOTHING REALLY EXISTS IN THIS RECORD
+5 IF $ORDER(^AUPNAUTH(AD0,11,0))=""
Begin DoDot:1
+6 DO CLEANZER(AD0)
+7 WRITE !,"RECORD DELETED!"
HANG 3
End DoDot:1
+8 QUIT
CLEANZER(AD0) ;EP
+1 KILL DIK,DA
+2 SET DIK="^AUPNAUTH("
SET DA=AD0
DO ^DIK
+3 QUIT
BADENTRY ;EP
+1 SET EXIT=1
+2 WRITE !,"Entry not made."
HANG 2
DO END
QUIT
+3 QUIT
END ;CLEAN UP THE VARS USED
+1 KILL AG,DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC,NEWENTRY
+2 KILL ROUTID
+3 QUIT
DRAW ;EP
+1 KILL CHOICES
+2 SET ROUTID=$PIECE($TEXT(+1)," ")
+3 SET AG("PG")="5BEC"
+4 DO ^AGED
+5 DO GETAW
+6 QUIT
GETAW ;DISP
+1 KILL AG("C")
+2 ;S ITEM=9
+3 ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
SET ITEM=8
+4 FOR AG=1:1
Begin DoDot:1
+5 SET AGSCRN=$PIECE($TEXT(@1+AG),";;",2,15)
+6 IF AGSCRN[("*END*")
QUIT
+7 ;FLD CAP
SET CAPTION=$PIECE(AGSCRN,U)
+8 ;PARSE OUT CAP
IF $EXTRACT(CAPTION)="-"
DO CAPPARSE(CAPTION)
QUIT
+9 ;FILE OR SUBFILE #
SET DIC=$PIECE(AGSCRN,U,3)
+10 ;FLD #
SET DR=$PIECE(AGSCRN,U,4)
+11 ;SKIP LOGIC. IF THIS IS TRUE WE
SET SKIPEXEC=$PIECE(AGSCRN,"|",6)
+12 ; DON'T DEAL WITH THIS FLD AT ALL
+13 IF SKIPEXEC'=""
XECUTE SKIPEXEC
IF $TEST
QUIT
+14 ;NEWLINE OR INDENT
SET NEWLINE=$PIECE(AGSCRN,U,5)
+15 ;CAP INDENT
SET CAPDENT=$PIECE(AGSCRN,U,2)
+16 ;ITEM #
SET ITEMNUM=$PIECE(AGSCRN,U,6)
+17 ;TAG TO CALL TO EDIT THIS FLD
SET TAGCALL=$PIECE($PIECE(AGSCRN,U,7),"|",1)
+18 ;USE TO DISP FLD WHICH IS DEPENDENT ON OTHER FLD
SET EXECUTE=$PIECE(AGSCRN,"|",2)
+19 ;PLACE CODE TO BE XECUTED PRIOR TO DISP OF THE FLD
SET PREEXEC=$PIECE(AGSCRN,"|",3)
+20 ;PLACE CODE TO EXECUTE BEF CAP/FLD LBL
SET PRECAPEX=$PIECE(AGSCRN,"|",4)
+21 ;PLACE CODE HERE TO BE EXECUTED AFT DISP OF THE FLD
SET POSTEXEC=$PIECE(AGSCRN,"|",5)
+22 ;SELECTION STRING
IF TAGCALL'=""
SET $PIECE(AG("C"),",",ITEMNUM)=TAGCALL
+23 WRITE @NEWLINE
+24 WRITE ITEMNUM
+25 WRITE $SELECT(ITEMNUM'="":". ",1:"")
+26 IF PRECAPEX=""
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,DR,0)),U)_": ")
+27 IF PRECAPEX'=""
XECUTE PRECAPEX
IF $TEST
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,DR,0)),U)_": ")
+28 ;IF EDITING,DISP DATA
+29 ;E DISP ONLY THE CAPS
+30 IF 'NEWENTRY
Begin DoDot:2
+31 SET D0=AD0
+32 IF DIC'["."
SET D0=D0_","
+33 IF '$TEST
SET D0=AD1_","_D0_","
+34 ;LOOP TO HANDLE MULTIPLE DR'S FOR ONE CAP
+35 NEW PIECE
+36 SET VDR=DR
+37 FOR PIECE=1:1
SET DR=$PIECE(VDR,";",PIECE)
IF DR=""
QUIT
Begin DoDot:3
+38 IF $PIECE(PREEXEC,";",PIECE)'=""
XECUTE $PIECE(PREEXEC,";",PIECE)
+39 IF $PIECE(EXECUTE,";",PIECE)=""
Begin DoDot:4
+40 ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
IF DR=.08
IF (DIC=9000046.11)
IF ($$GET1^DIQ(DIC,D0,DR)'="")
WRITE $JUSTIFY($$GET1^DIQ(DIC,D0,DR),10,2)
QUIT
+41 ;BAR*1.8*4 IHS/SD/TPF 3/27/08 IM28348
IF DR=.09
IF (DIC=9000046.11)
IF ($$GET1^DIQ(DIC,D0,DR)'="")
WRITE $EXTRACT($$GET1^DIQ(DIC,D0,DR),1,20)
QUIT
+42 IF '$TEST
WRITE $$GET1^DIQ(DIC,D0,DR)
End DoDot:4
+43 IF $PIECE(EXECUTE,";",PIECE)'=""
SET D0=$TRANSLATE(D0,",")
XECUTE $PIECE(EXECUTE,";",PIECE)
+44 IF $PIECE(POSTEXEC,";",PIECE)'=""
XECUTE $PIECE(POSTEXEC,";",PIECE)
End DoDot:3
+45 KILL PIECE
+46 ;LIST ADDITIONAL DAYS AUTHORIZED
+47 IF DIC[".1201"!(DIC[".1101")
Begin DoDot:3
+48 SET SUBSCRIP=$SELECT(DIC[".1201":2,1:1)
+49 SET VD0=AD0
+50 SET VD1=AD1
+51 IF DIC[".1101"
IF '$DATA(^AUPNAUTH(VD0,11,VD1,SUBSCRIP))
WRITE !,"***NO AUTH. ENCOUNTER CONTACTS***"
QUIT
+52 IF DIC[".1201"
IF '$DATA(^AUPNAUTH(VD0,11,VD1,SUBSCRIP))
WRITE !,"***NO ADDITIONAL "_$GET(TYPEFLAG)_" AUTHORIZED***"
QUIT
+53 SET VD2=0
+54 FOR
SET VD2=$ORDER(^AUPNAUTH(VD0,11,VD1,SUBSCRIP,VD2))
IF 'VD2
QUIT
Begin DoDot:4
+55 SET ITEM=ITEM+1
+56 SET CHOICES(ITEM)=DIC_U_VD0_U_VD1_U_VD2
+57 SET D0=VD2_","_VD1_","_VD0_","
+58 IF ITEM=1
WRITE ?0,ITEM_"."
+59 IF '$TEST
WRITE !,ITEM_"."
+60 NEW PIECE
+61 FOR PIECE=1:1
SET DR=$PIECE(VDR,";",PIECE)
IF DR=""
QUIT
Begin DoDot:5
+62 IF $PIECE(PREEXEC,";",PIECE)'=""
XECUTE $PIECE(PREEXEC,";",PIECE)
+63 IF $PIECE(EXECUTE,";",PIECE)=""
Begin DoDot:6
+64 WRITE $SELECT(DR=.02:$EXTRACT($$GET1^DIQ(DIC,D0,DR),1,15),DR=.04:$EXTRACT($$GET1^DIQ(DIC,D0,DR),1,19),1:$$GET1^DIQ(DIC,D0,DR))
End DoDot:6
+65 IF $PIECE(EXECUTE,";",PIECE)'=""
XECUTE $PIECE(EXECUTE,";",PIECE)
+66 IF $PIECE(POSTEXEC,";",PIECE)'=""
XECUTE $PIECE(POSTEXEC,";",PIECE)
End DoDot:5
+67 KILL PIECE
End DoDot:4
End DoDot:3
+68 ;LIST WORD PROCESSING FLDS
+69 IF DIC["9000046.1301"
Begin DoDot:3
+70 SET ITEM=ITEM+1
+71 WRITE !,ITEM_". NOTES: "
+72 SET $PIECE(AG("C"),",",ITEM)="EDENCNOT"
+73 KILL ^UTILITY($JOB,"W")
+74 SET DIWL=12
SET DIWR=75
+75 SET DIWF="WC65|"
+76 SET VD0=AD0
+77 SET VD1=AD1
+78 SET VD2=0
+79 FOR
SET VD2=$ORDER(^AUPNAUTH(VD0,11,VD1,3,VD2))
IF 'VD2
QUIT
Begin DoDot:4
+80 SET X=$GET(^AUPNAUTH(VD0,11,VD1,3,VD2,0))
+81 DO ^DIWP
End DoDot:4
+82 DO ^DIWW
End DoDot:3
End DoDot:2
End DoDot:1
IF $GET(AGSCRN)[("*END*")
QUIT
+83 SET AG("N")=$GET(ITEM)
+84 KILL MYERRS,MYVARS
+85 DO FETCHERR^AGEDERR(AG("PG"),.MYERRS)
+86 SET MYVARS("DFN")=DFN
SET MYVARS("FINDCALL")=""
SET MYVARS("SELECTION")=$GET(AGSELECT)
SET MYVARS("SITE")=DUZ(2)
+87 DO EDITCHEK^AGEDERR(.MYERRS,.MYVARS,1)
+88 WRITE $GET(AGLINE("-"))
+89 DO VERIF^AGUTILS
+90 QUIT
CAPPARSE(CAPTION) ;EP - PARSE OUT THE CAP
+1 NEW LBRACKET,RBRACKET,EXEC
+2 SET LBRACKET="["
SET RBRACKET="]"
+3 ;- DENOTES SIMPLE SECTION
IF CAPTION'[LBRACKET
WRITE !,$EXTRACT(CAPTION,2,199)
QUIT
+4 ;PARSE OUT AND INSERT FLD VALUES
+5 SET FIELDS=$LENGTH(CAPTION,LBRACKET)
+6 WRITE !,$EXTRACT($PIECE(CAPTION,LBRACKET),2,199)
+7 FOR PIECE=1:1:FIELDS
Begin DoDot:1
+8 SET FIELD=$PIECE($PIECE(CAPTION,LBRACKET,PIECE),RBRACKET)
+9 IF $PIECE(FIELD,";",3)=""
WRITE $$GET1^DIQ($PIECE(FIELD,";"),AD1_","_AD0_",",$PIECE(FIELD,";",2))
+10 IF $PIECE(FIELD,";",3)'=""
SET EXEC=$PIECE(FIELD,";",3)
Begin DoDot:2
+11 SET X=$$GET1^DIQ($PIECE(FIELD,";"),AD1_","_AD0_",",$PIECE(FIELD,";",2),"I")
XECUTE EXEC
End DoDot:2
End DoDot:1
+12 WRITE $PIECE(CAPTION,RBRACKET,2)
+13 KILL LBRACKET,RBRACKET,EXEC
+14 QUIT
WMSG ;DISP THIS MSG IF THERE IS NO AUTHORIZATION DT FOUND
+1 WRITE !,"You must first enter a AUTHORIZATION DATE"
+2 QUIT
+3 ;;;;;;;;;;;;;;;;;;;;;;;;;
+4 ; EDIT AUTHORIZATION FLDS
+5 ;;;;;;;;;;;;;;;;;;;;;;;;;
NEWENTRY ;NEW ENTRY
+1 WRITE !!
+2 KILL DIC,DIE,DR,DA
+3 SET DIC="^AUPNAUTH("
+4 SET DIC(0)="L"
+5 SET DIC("S")="I $G(Y)'=TEMPDFN"
+6 SET X="`"_DFN
+7 SET TEMPDFN=DFN
+8 DO ^DIC
+9 SET DFN=TEMPDFN
+10 IF +Y'>0
QUIT
+11 SET AD0=+Y
NEWENCDT ;ENTER NEW ENCOUNTER DT
+1 KILL DIC,DIE,DR,DA
+2 SET DA(1)=AD0
+3 SET DIC="^AUPNAUTH("_DA(1)_",11,"
+4 SET DIC(0)="ALMEQ"
+5 KILL DD,DO
+6 DO ^DIC
+7 IF +Y'>0
QUIT
+8 SET AD1=+Y
EDENTYPE ;EDIT ENCOUNTER TYPE
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=".03R"
SET DIE("NO^")=""
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDENCDT ;EDIT ENCOUNTER DT
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=".01"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDINSNAM ;EP - EDIT INSURANCE COMPANY
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=.04
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDPRCERT ;EP - EDIT PRE-CERT DT
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=".05"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 IF $PIECE($GET(^AUPNAUTH(AD0,11,AD1,0)),U,5)
DO EDAUTHST
+9 QUIT
EDCRTNUM ;EDIT PRE-CERT #
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=.06
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDADMDT ;EDIT ADMISSION DT
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=.02
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDAUTHDY ;EDIT AUTHORIZED DAYS
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=.07
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDMAXDOL ;EDIT MAX DOLLARS
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD0
+3 SET DA=AD1
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=.08
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDSRVCAT ;EDIT SERVICE CATEGORY
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=AD1
+3 SET DA(1)=AD0
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=".09"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDAUTHVS ;EDIT AUTHORIZED VISITS
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=AD1
+3 SET DA(1)=AD0
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 SET DR=".11"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
EDAUTHST ;EDIT AUTHORIZATION STATUS
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA=AD1
+3 SET DA(1)=AD0
+4 SET DIE="^AUPNAUTH("_DA(1)_",11,"
+5 ;IF PRE-CERT DT, MAKE AUTH STATUS REQUIRED
+6 IF $PIECE($GET(^AUPNAUTH(AD0,11,AD1,0)),U,5)
SET DR=".12R"
SET DIE("NO^")=""
+7 IF '$TEST
SET DR=".12"
+8 DO ^DIE
+9 KILL DIC,DR,DIE,DA
+10 QUIT
EDENCNOT ;EDIT ENCOUNTER NOTES
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=AD1
+3 SET DA(2)=AD0
+4 SET DIC="^AUPNAUTH("_DA(2)_",11,"_DA(1)_",3,"
+5 DO EN^DIWE
+6 KILL DIC,DR,DIE,DA
+7 QUIT
+8 ;USED ONLY FOR VIEW OPTION
DISNOTES ;EP
+1 IF '$DATA(^AUPNAUTH(AD0,11,AD1,3))
WRITE !,"NO NOTES TO VIEW"
HANG 2
QUIT
+2 NEW LN,X
+3 SET LN=0
+4 WRITE !!
+5 FOR
SET LN=$ORDER(^AUPNAUTH(AD0,11,AD1,3,LN))
IF 'LN
QUIT
Begin DoDot:1
+6 SET X=$GET(^AUPNAUTH(AD0,11,AD1,3,LN,0))
+7 DO ^DIWP
End DoDot:1
+8 DO ^DIWW
+9 KILL DIR
SET DIR(0)="E"
DO ^DIR
+10 QUIT
+11 ; ****************************************************************
+12 ; ON LINES BELOW:
+13 ; U "^" DELIMITED
+14 ; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
+15 ; PIECE VAR DESC
+16 ; ----- -------- -----------------------------------------------
+17 ; 1 CAPTION FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LBL IF POPULATED
+18 ; 2 CAPDENT POS ON LINE TO DISP CAP
+19 ; 3 DIC FILE OR SUBFILE #
+20 ; 4 DR FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
+21 ; MULTIPLE FLDS TO BE PRINTED WITH THE SAME CAP AS IN
+22 ; 'CITY,STATE,ZIP'
+23 ; 5 NEWLINE NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#')
+24 ; USE THIS TO INDENT THE LINE
+25 ; 6 ITEMNUM ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM #
+26 ; USED TO ALLOW USER TO CHOOSE THIS FLD TO EDIT
+27 ; 7 TAGCALL TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO BE EDITED
+28 ;
+29 ; BAR "|" DELIMITED
+30 ; PIECE VAR DESC
+31 ; ----- -------- ----------------------------------------------
+32 ; 2 EXECUTE EXECUTE CODE TO GET FLD THAT OTHER IS POINTING TO.
+33 ; EXECUTED AFT FLD PRINT. IF MUTL FILEDS ARE PRINTED
+34 ; THEN MULTIPLE EXECUTE CODES CAN BE SEPARATED BY ";".
+35 ; 3 PREEXEC EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
+36 ; PRINTING A FIELD VALUE. FOR MULTIPLES SEPARATE BY ";"
+37 ; 4 PRECAPEX EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
+38 ; USE TO SCREEN OUT PRINTING A CAP/FLD LBL
+39 ; 5 POSTEXEC EXECUTE CODE TO DO AFT PRINTING THE FLD DATA
+40 ; FOR MULTIPLES SEPARATE BY ";"
+41 ; 6 SKIPEXEC EXECUTE CODE TO SKIP ENTIRE FLD
+42 ;
1 ;
+1 ;;- BENEFITS COORDINATION
+2 ;;--[9000046.11;.03] - PRIOR AUTHORIZATIONS----------------------------------------------
+3 ;;Auth. Encounter Date^?0^9000046.11^.01^!^1^EDENCDT
+4 ;;Insurance Name^?0^9000046.11^.04^!^2^EDINSNAM
+5 ;;Pre-Auth Date^?0^9000046.11^.05^!^3^EDPRCERT
+6 ;;Pre-Auth Number^?0^9000046.11^.06^?45^4^EDCRTNUM
+7 ;;Admission Date^?0^9000046.11^.02^!^5^EDADMDT|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
+8 ;;Authorized Days^?0^9000046.11^.07^?45^6^EDAUTHDY|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
+9 ;;Max Dollar....^?0^9000046.11^.08^!^7^EDMAXDOL|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="IP"
+10 ;;Service Category^?0^9000046.11^.09^!^5^EDSRVCAT|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="OP"
+11 ;;Authorized Visits^?0^9000046.11^.11^?45^6^EDAUTHVS|||||I $$GET1^DIQ(9000046.11,AD1_","_AD0_",",.03,"I")'="OP"
+12 ;;Authorization Status^?0^9000046.11^.12^!^8^EDAUTHST
+13 ;;-
+14 ;;--CONTACT DATES------------------------------------------------------------------
+15 ;;-CONTACT DATE CONTACT PERSON PHONE FAX E-MAIL
+16 ;;---------------------------------------------------------------------------------
+17 ;;^?0^9000046.1101^.01;.02;.03;.05;.04^?0^^||;W ?17;W ?35;W ?50;W ?60
+18 ;;-
+19 ;;--REQUEST FOR ADDITIONAL [9000046.11;.03;S TYPEFLAG=$S(X="OP":"VISITS",1:"DAYS") W TYPEFLAG] -------------------------------------------------
+20 ;;-Date Obtained Reference # Additional [9000046.11;.03;W $S(X="OP":"VISITS",1:"DAYS")] Authorized
+21 ;;---------------------------------------------------------------------------------
+22 ;;^?0^9000046.1201^.01;.02;.07;.08^?0^^||;W ?25;W ?55
+23 ;;---------------------------------------------------------------------------------
+24 ;;^?0^9000046.1301^.01^?0^^EDENCNOT
+25 ;;*END*
