Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGEDBEA

AGEDBEA.m

Go to the documentation of this file. 
  1. AGEDBEA ; IHS/ASDS/TPF - EDIT/DISPLAY BENEFITS COORDINATOR - MAIN SCREEN ;    
  1.  ;;7.1;PATIENT REGISTRATION;**1,2,8**;AUG 25, 2005
  1.  ;
  1. EN ;
  1.  S NEWENTRY=0    ;BD0=DFN  THIS SCREEN DISPLAYS ALL CURRENT ENTRIES
  1.  ;                NEW ENTRIES ARE MADE ON OTHER SCREENS
  1.  ;
  1. VAR D DRAW
  1.  W !,AGLINE("EQ")
  1.  K DIR
  1.  I '$D(AGSEENLY) D
  1.  .;I AG("N")=0 S DIR("A")="Add <C>ase or <A>uthorization"
  1.  .;E  S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization"
  1.  .;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 14
  1.   .S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization, or <V>iew closed cases"
  1.  .I AG("N")=0,'($G(CLOSED)) S DIR("A")="Add <C>ase or <A>uthorization,"
  1.  .;I AG("N")=0,($G(CLOSED)) S DIR("A")="Add <C>ase or <A>uthorization, or <V>iew closed cases"
  1.  .I '$D(^XUSEC("AGZCREOPN",DUZ)),AG("N")=0,($G(CLOSED)) S DIR("A")="Add <C>ase or <A>uthorization, or <V>iew closed cases"  ;AG*7.1*8
  1.  .I $D(^XUSEC("AGZCREOPN",DUZ)),AG("N")=0,($G(CLOSED)) S DIR("A")="Add <C>ase or <A>uthorization, <R>e-open or <V>iew closed cases"  ;AG*7.1*8
  1.  .I AG("N"),'$G(CLOSED) S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization"
  1.  .;I AG("N"),$G(CLOSED) S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization, or <V>iew closed cases"
  1.  .I '$D(^XUSEC("AGZCREOPN",DUZ)),AG("N"),$G(CLOSED) S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization, or <V>iew closed cases"  ;AG*7.1*8
  1.  .I $D(^XUSEC("AGZCREOPN",DUZ)),AG("N"),$G(CLOSED) S DIR("A")="Change which item (1-"_AG("N")_") OR Add <C>ase or <A>uthorization, <R>e-open or <V>iew closed cases"  ;AG*7.1*8
  1.  .N CTDIR S CTDIR=0
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="You may enter the item number of the field you wish to edit,"
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="the page you wish to jump to, OR enter '^' to go back one page"
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR, enter '^^' to exit the edit screens, OR RETURN to go to the next screen."
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR 'C' to enter a new case,"
  1.  .S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR 'A' to enter a new authorization,"
  1.  .I $G(CLOSED) S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR 'R' to re-open a closed case,"
  1.  .I $G(CLOSED) S CTDIR=CTDIR+1,DIR("?",CTDIR)="OR 'V' to view closed cases."
  1.  I $D(AGSEENLY) D
  1.  .;S DIR("A")="Enter item number to view"
  1.  .;S DIR="LO^1"_AG("N")
  1.  .;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 14
  1.  .I AGSEENLY="" D
  1.  ..S DIR("A")="Enter item number to view"
  1.  ..S DIR(0)="LO^1"_AG("N")
  1.  .I AGSEENLY=2 D
  1.  ..S DIR("A")="Enter item number to view or <R>esume editing"
  1.  ..S DIR(0)="F"_U_"1:"_$L(AG("N"))
  1.  ..S DIR("B")="R"
  1.  D READ^AGED1
  1.  G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) END
  1.  G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))
  1.  G END:$D(DLOUT)!(Y["N")!$D(DUOUT),VAR:$D(AG("ERR"))
  1.  G:$D(DFOUT)!$D(DTOUT) END
  1.  ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 14
  1.  I $G(AGSEENLY)=2 D   G:'$D(AGSEENLY) VAR
  1.  .I +X'=X,(X'="R") S X="R" W !,"Enter an R to Resume editing or a item number" Q
  1.  .I X="R" K AGSEENLY Q
  1.  I Y="V" S AGSEENLY=2 G VAR
  1.  I Y="R",$D(^XUSEC("AGZCREOPN",DUZ)),($G(CLOSED)) D CLS^AGEDBEI(DFN,CLOSED) G VAR
  1.  I Y="R" G VAR
  1.  ;END NEW CODE
  1.  ;ENTER ROUTINES TO ADD ENTRY
  1.  I $G(Y)="C"!($G(Y)="A") D @$S(Y="C":"EN^AGEDBEB("""","""",1)",1:"EN^AGEDBEC("""","""",1)") G VAR
  1.  ;IF NUMBER CHOSEN THEN THE USER WANTS TO EDIT ONE OF THE ITEMS LISTED ON THE SCREEN
  1.  I AG("N")=0 W !,"There are no items to select!" H 3 G VAR
  1.  I $D(DQOUT)!(+Y<1)!(+Y>AG("N")) W !!,"You must enter a number from 1 to ",AG("N") H 2 G VAR
  1.  ;DEPENDING ON USER CHOICE ITEM MAY BE A CASE OR AN AUTH.
  1.  ;ENTER ROUTINES TO EDIT
  1.  I $D(CHOICES(+Y)) S DORTN=$S($P(CHOICES(+Y),U)[9000044:"EN^AGEDBEB",1:"EN^AGEDBEC"),PARAM1=$P(CHOICES(+Y),U,2),PARAM2=$P(CHOICES(+Y),U,3) S DORTN=DORTN_"("_PARAM1_","_PARAM2_","_"0)" D @DORTN G VAR
  1.  D UPDATE1^AGED(DUZ(2),DFN,3,"")
  1.  K AGI,AGY
  1.  G VAR
  1. END K DORTN
  1.  K DLOUT,DTOUT,DFOUT,DQOUT,DA,DIC,DR,AGSCRN,Y,ADA,WDA,ADT,WDT,ADFN,WDFN,REC,NEWENTRY,BD0,BD1,ROUTID
  1.  Q:$D(AGXTERN)
  1.  Q:$D(DIROUT)
  1.  Q:$D(AGSEENLY)
  1.  G ^AGED4A:$D(DUOUT)
  1.  G ^AGED13
  1.  Q
  1. DRAW ;EP
  1.  K CHOICES
  1.  S AG("PG")="5BEA"
  1.  S ROUTID=$P($T(+1)," ")
  1.  D ^AGED  ;SCREEN HEADER ROUTINE
  1.  D GETAW
  1.  Q
  1. GETAW ;DISP
  1.  S:'$D(AUPNPAT) AUPNPAT=$G(DFN)
  1.  I AUPNPAT="" W !!,"PATIENT IEN NOT DEFINED!" H 2 Q
  1.  S BD0=$O(^AUPNBENR("B",AUPNPAT,""))  ;GET CASE IEN OF PATIENT THEN GET ALL CASES ASSIGNED TO BEN. COORD.
  1.  S CD0=$O(^AUPNAUTH("B",AUPNPAT,""))  ;GET AUTHORIZATION IEN
  1.  K CHOICES  ;RESET THE ALLOWABLE CHOICES
  1.  K AG("C")
  1.  S ITEM=0
  1.  F AG=1:1 D  Q:$G(AGSCRN)[("*END*")
  1.  . ;S AGSCRN=$P($T(@2+AG),";;",2,15)  ;OPTIONAL DISP
  1.  . I $G(AGSEENLY)=2 S AGSCRN=$P($T(@3+AG),";;",2,15)  ;CLOSED DISPLAY - AG*7.1*8
  1.  . E  S AGSCRN=$P($T(@2+AG),";;",2,15)  ;OPTIONAL DISP - AG*7.1*8
  1.  . Q:AGSCRN[("*END*")
  1.  . S CAPTION=$P(AGSCRN,U)  ;FLD CAP
  1.  . I $E(CAPTION)="-" W !,$E(CAPTION,2,199) Q  ;- DENOTES SECTION 
  1.  . S DIC=$P(AGSCRN,U,3)    ;FILE OR SUBFILE #
  1.  . S VDR=$P(AGSCRN,U,4)      ;FLD #
  1.  . S NEWLINE=$P(AGSCRN,U,5)  ;NEWLINE OR INDENT
  1.  . S CAPDENT=$P(AGSCRN,U,2)   ;CAP INDENT
  1.  . S ITEMNUM=$P(AGSCRN,U,6)   ;ITEM #
  1.  . S TAGCALL=$P($P(AGSCRN,U,7),"|",1)   ;TAG TO CALL TO EDIT THIS FLD
  1.  . S EXECUTE=$P(AGSCRN,"|",2)      ;USE TO DISP FLD WHICH IS DEPENDENT ON ANOTHER FLD
  1.  . S PREEXEC=$P(AGSCRN,"|",3)     ;PLACE CODE TO BE XECUTED PRIOR TO DISP OF THE FLD
  1.  . S PRECAPEX=$P(AGSCRN,"|",4)   ;PLACE CODE TO EXECUTE BEF CAP/FLD LBL
  1.  . S POSTEXEC=$P(AGSCRN,"|",5)    ;PLACE CODE HERE TO BE EXECUTED AFT DISP OF THE FLD
  1.  . S:TAGCALL'="" $P(AG("C"),",",ITEMNUM)=TAGCALL   ;SELECTION STRING
  1.  . W @NEWLINE
  1.  . W ITEMNUM
  1.  . W $S(ITEMNUM'="":". ",1:"")
  1.  . I PRECAPEX="" W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,VDR,0)),U)_": ")
  1.  . I PRECAPEX'="" X PRECAPEX I $T W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,VDR,0)),U)_": ")
  1.  .;IF EDITING DISPLAY DATA ONLY
  1.  .;E DISP ONLY THE CAPS
  1.  .D
  1.  .. S VD0=BD0
  1.  .. I DIC'["." S VD0=D0_"," D
  1.  ... ;LOOP TO HANDLE MULTIPLE DR'S FOR ONE DIC
  1.  ... N PIECE
  1.  ... F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR=""  D
  1.  .... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
  1.  .... I $P(EXECUTE,";",PIECE)="" W $$GET1^DIQ(DIC,VD0,DR)
  1.  .... I $P(EXECUTE,";",PIECE)'="" S VD0=$TR(D0,",") X $P(EXECUTE,";",PIECE)
  1.  .... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
  1.  ...K PIECE
  1.  ...;NOW LETS HANDLE THE CASE DATE SUBFILE
  1.  .. I DIC["9000044."  D
  1.  ... I $G(BD0)="" S BD0="NOREF"
  1.  ... I '$O(^AUPNBENR(BD0,11,0)) W !,"PATIENT HAS NO CASE DATE ENTRIES!",! Q
  1.  ... S CLOSED=0
  1.  ... S NOTCLOSE=0
  1.  ... ;
  1.  ... ;Start of new (modified) code for AG*7.1*8
  1.  ... ;
  1.  ... ;Get list of closed cases, sort by complete date
  1.  ... N CLCASE,CLIEN,CDT
  1.  ... S CLIEN=0 F  S CLIEN=$O(^AUPNBENR(VD0,11,CLIEN)) Q:'CLIEN  D
  1.  .... ;
  1.  .... ;Get a list of cases - Closed view is sorted by completed date, Other View is by IEN
  1.  .... S D0=CLIEN_","_VD0_","
  1.  .... ;I $$GET1^DIQ(DIC,D0,.07)="CLOSED",('$D(AGSEENLY)) S CLOSED=CLOSED+1 Q  ;SKIP CLOSED RECORDS
  1.  .... ;BEGIN NEW CODE IHS/SD/TPF AG*7.1*1 ITEM 14
  1.  .... I $G(AGSEENLY)=2 S CDT=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.11,"I") S:CDT="" CDT="~"
  1.  .... I $G(AGSEENLY)'=2 S CDT=$G(CDT)-1
  1.  .... I $$GET1^DIQ(DIC,D0,.07)="CLOSED",($G(AGSEENLY)="") S CLOSED=CLOSED+1 Q  ;SKIP CLOSED RECORDS
  1.  .... I $$GET1^DIQ(DIC,D0,.07)="OPEN"!($$GET1^DIQ(DIC,D0,.07)=""),($G(AGSEENLY)="") S NOTCLOSE=NOTCLOSE+1  ;COUNT OPEN RECORDS
  1.  .... I $$GET1^DIQ(DIC,D0,.07)="OPEN"!($$GET1^DIQ(DIC,D0,.07)=""),($G(AGSEENLY)=2) Q  ;IHS/SD/TPF AG*7.1*1 ITEM 14 SKIP OPEN RECORDS IF IN VIEW CLOSED RECORDS MODE
  1.  .... S CLCASE(CDT,CLIEN)=DIC_U_VD0_U_CLIEN
  1.  ... ;
  1.  ... ;Loop through list and display
  1.  ... S CDT="" F  S CDT=$O(CLCASE(CDT),-1) Q:CDT=""  S BD1="" F  S BD1=$O(CLCASE(CDT,BD1)) Q:'BD1  D
  1.  .... ;
  1.  .... S ITEM=ITEM+1
  1.  .... S CHOICES(ITEM)=CLCASE(CDT,BD1)
  1.  .... S D0=BD1_","_VD0_","
  1.  .... ;
  1.  .... ;End of modified code for AG*7.1*8
  1.  .... ;
  1.  .... I ITEM=1 W ?0,ITEM_"."
  1.  .... E  W !,ITEM_"."
  1.  .... N PIECE
  1.  .... F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR=""  D 
  1.  ..... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
  1.  ..... I $P(EXECUTE,";",PIECE)="" D
  1.  ...... W $S(DR=.02:$E($$GET1^DIQ(DIC,D0,DR),1,15),DR=.12:$E($$GET1^DIQ(DIC,D0,DR),1,25),1:$$GET1^DIQ(DIC,D0,DR))
  1.  ..... I $P(EXECUTE,";",PIECE)'="" X $P(EXECUTE,";",PIECE)
  1.  ..... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
  1.  ....K PIECE
  1.  ...;I 'NOTCLOSE,CLOSED W !,"PATIENT HAS "_CLOSED_" CLOSED CASES",!
  1.  ... I $G(CLOSED) W !,"PATIENT HAS "_CLOSED_" CLOSED CASE"_$S(CLOSED>1:"S",1:""),!  ;IHS/SD/TPF AG*7.1*1 ITEM 14
  1.  .. I DIC["9000046."  D
  1.  ... I $G(CD0)="" W !,"PATIENT HAS NO AUTHORIZATION ENCOUNTER DATES!",! Q
  1.  ... I '$O(^AUPNAUTH(CD0,11,0)) W !,"PATIENT HAS NO AUTHORIZATION ENCOUNTER DATES!",!
  1.  ... S BD1=0
  1.  ... F  S BD1=$O(^AUPNAUTH(CD0,11,BD1)) Q:'BD1  D
  1.  .... S ITEM=ITEM+1
  1.  .... S CHOICES(ITEM)=DIC_U_CD0_U_BD1
  1.  .... S D0=BD1_","_CD0_","
  1.  .... W !,ITEM_"."
  1.  .... N PIECE
  1.  .... F PIECE=1:1 S DR=$P(VDR,";",PIECE) Q:DR=""  D 
  1.  ..... I $P(PREEXEC,";",PIECE)'="" X $P(PREEXEC,";",PIECE)
  1.  ..... I $P(EXECUTE,";",PIECE)="" D
  1.  ......W $S(DR=.03:$E($$GET1^DIQ(DIC,D0,DR,"I")),DR=.04:$E($$GET1^DIQ(DIC,D0,DR,"E"),1,20),1:$$GET1^DIQ(DIC,D0,DR))
  1.  ..... I $P(EXECUTE,";",PIECE)'="" X $P(EXECUTE,";",PIECE)
  1.  ..... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
  1.  ....K PIECE
  1.  S AG("N")=$G(ITEM)
  1.  W !,$G(AGLINE("-"))
  1.  D VERIF^AGUTILS
  1.  Q
  1.  ;
  1.  ; ****************************************************************
  1.  ; ON LINES BELOW:
  1.  ; U "^" DELIMITED
  1.  ; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
  1.  ; PIECE  VAR       DESC
  1.  ; -----  --------  -----------------------------------------------
  1.  ; 1      CAPTION    FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LBL IF POPULATED
  1.  ; 2      CAPDENT    POSITION ON LINE TO DISP CAP
  1.  ; 3      DIC        FILE OR SUBFILE #
  1.  ; 4      DR         FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
  1.  ;                   MULTIPLE FLDS TO BE PRINTED WITH THE SAME CAP AS IN
  1.  ;                   'CITY,STATE,ZIP'
  1.  ; 5      NEWLINE    NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#') USE THIS TO INDENT THE LINE
  1.  ; 6      ITEMNUM    ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM # USED TO CHOOSE THIS
  1.  ;                   FLD ON THE SCREEN
  1.  ; 7      TAGCALL    TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO BE EDITED
  1.  ; 
  1.  ; BAR "|" DELIMITED
  1.  ; PIECE  VAR        DESC
  1.  ; -----  --------   ----------------------------------------------
  1.  ; 2      EXECUTE    EXECUTE CODE TO GET FLD THAT ANOTHER IS POINTING TO.
  1.  ;                   EXECUTED TO PRINT THE FLD. IF MUTLIPLE FLDS ARE PRINTED
  1.  ;                   THEN MULTIPLE EXECUTE CODES CAN BE SEPARATED BY ";".
  1.  ; 3      PREEXEC    EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
  1.  ;                   PRINTING A FLD VALUE. FOR MULTIPLES SEPARATE BY ";"
  1.  ; 4      PRECAPEX   EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
  1.  ;                   USE TO SCREEN OUT PRINTING A CAP/FLD LBL
  1.  ; 5      POSTEXEC   EXECUTE CODE TO DO AFT PRINTING THE FLD DATA.
  1.  ;                   FOR MULTIPLES SEPARATE BY ";"
  1. 1 ;
  1.  ;;^?0^9000044.11^.01;.02;.03;.12;.07^!^^||W "CASE DATE: ";W ?45,"to ";W ?72,"by ";W !?10,"Reason: ";W ?60,"Status: "
  1.  ;;-================================================================================
  1.  ;;-PRIOR AUTHORIZATION   DATE       INSURER
  1.  ;;---------------------------------------------------------------------------------
  1.  ;;^?3^^^!^2^EDITPRE
  1.  ;;*END*
  1.  ;
  1.  ;ALTERNATE DISPLAY
  1. 2 ;
  1.  ;;-                             BENEFITS COORDINATION
  1.  ;;-================================================================================
  1.  ;;-CASE DATE          ASSIGNED TO     ASSIGNED BY       REASON        
  1.  ;;---------------------------------------------------------------------------------
  1.  ;;^?0^9000044.11^.01;.02;.03;.12^?0^^|;;;;W $S($$GET1^DIQ(DIC,D0,DR)="":"OPEN",1:$$GET1^DIQ(DIC,D0,DR))|;W ?19;W ?35;W ?53;W ?70
  1.  ;;-================================================================================
  1.  ;;-PRIOR AUTHORIZATION  ENCOUNTER DATE  ADMISSION DATE  INSURER              TYPE
  1.  ;;---------------------------------------------------------------------------------
  1.  ;;^?0^9000046.11^.06;.01;.02;.04;.03^?0^^EDITPRE||;W ?21;W ?37;W ?52;W ?75
  1.  ;;*END*
  1.  ;
  1.  ;CLOSED VIEW DISPLAY
  1. 3 ;
  1.  ;;-                             BENEFITS COORDINATION
  1.  ;;-================================================================================
  1.  ;;-COMPLETED DATE  CASE DATE       ASSIGNED TO       REASON
  1.  ;;---------------------------------------------------------------------------------
  1.  ;;^?0^9000044.11^.11;.01;.02;.12^?0^^|;;;;;W $S($$GET1^DIQ(DIC,D0,DR)="":"OPEN",1:$$GET1^DIQ(DIC,D0,DR))|;W ?17;W ?33;W ?51
  1.  ;;-================================================================================
  1.  ;;-PRIOR AUTHORIZATION  ENCOUNTER DATE  ADMISSION DATE  INSURER              TYPE
  1.  ;;---------------------------------------------------------------------------------
  1.  ;;^?0^9000046.11^.06;.01;.02;.04;.03^?0^^EDITPRE||;W ?21;W ?37;W ?52;W ?75
  1.  ;;*END*