AGEDBEI ; VNGT/HS/BEE - DISPLAY/EDIT CLOSED CASES ;
;;7.1;PATIENT REGISTRATION;**8**;AUG 25, 2005
;
Q
;
CLS(DFN,CLOSED) N ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
;
VAR N CHOICES,DIR,DQOUT,Y
DRAW ;EP
S AG("PG")="5BEI"
S ROUTID=$P($T(+1)," ")
D ^AGED ;SCREEN HEADER ROUTINE
D GETAW
;
S DIR("A")="Select 1-"_AG("N")
S DIR("?",1)="Enter the item number of the case you wish to reopen."
S DIR(0)="N^1:"_AG("N")_":0"
;
;
D READ^AGED1
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!('+Y) EXIT
I AG("N")=0 W !,"There are no items to select!" H 3 G EXIT
I $D(DQOUT)!(+Y<1)!(+Y>AG("N"))!'$D(CHOICES(+Y)) W !!,"You must enter a number from 1 to ",AG("N") H 2 K AG,CHOICES,DIR,DQOUT,Y G VAR
S PARAM1=$P(CHOICES(+Y),U,2),PARAM2=$P(CHOICES(+Y),U,3)
;
;Remove Closed Status
D STAT(PARAM1,PARAM2)
;
;Remove Completed By
D COMBY(PARAM1,PARAM2)
;
;Remove Date Completed
D COMDT(PARAM1,PARAM2)
;
;Update the registration
D UPDATE1^AGED(DUZ(2),DFN,3,"")
;
;Edit the Case
S DORTN="EN^AGEDBEB("_PARAM1_","_PARAM2_","_"0)" D @DORTN K AG,CHOICES,DIR,DQOUT,Y G VAR
;
EXIT K ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
K AG,CHOICES,DIR,DQOUT,Y
Q
GETAW ;DISP
N AUPNPAT,BD0,ITEM,AGSCRN
S AUPNPAT=$G(DFN)
I AUPNPAT="" W !!,"PATIENT IEN NOT DEFINED!" H 2 Q
;
S BD0=$O(^AUPNBENR("B",AUPNPAT,"")) ;GET CASE IEN OF PATIENT THEN GET ALL CASES ASSIGNED TO BEN. COORD.
K AG("C")
S ITEM=0
F AG=1:1 D Q:$G(AGSCRN)[("*END*")
. N CAPTION,CAPDENT,DIC,EXECUTE,ITEMNUM,NEWLINE,POSTEXEC,PRECAPEX,PREEXEC,TAGCALL,VD0,VDR
. S AGSCRN=$P($T(@2+AG),";;",2,15) ;OPTIONAL DISP
. Q:AGSCRN[("*END*")
. S CAPTION=$P(AGSCRN,U) ;FLD CAP
. I $E(CAPTION)="-" W !,$E(CAPTION,2,199) Q ;- DENOTES SECTION
. S DIC=$P(AGSCRN,U,3) ;FILE OR SUBFILE #
. S VDR=$P(AGSCRN,U,4) ;FLD #
. 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 ANOTHER 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,VDR,0)),U)_": ")
. I PRECAPEX'="" X PRECAPEX I $T W @CAPDENT,$S($G(CAPTION)'="":CAPTION_": ",$G(CAPTION)="":"",1:$P($G(^DD(DIC,VDR,0)),U)_": ")
. ;
. S VD0=BD0
. ;
. ;Pull Case Information
. ;
. I DIC["9000044." D
.. N CDT,BD1,D0
.. I $G(BD0)="" S BD0="NOREF"
.. I '$O(^AUPNBENR(BD0,11,0)) W !,"PATIENT HAS NO CASE DATE ENTRIES!",! Q
.. ;
.. ;Get list of closed cases, sort by complete date
.. N CLCASE,CLIEN
.. S CLIEN=0 F S CLIEN=$O(^AUPNBENR(VD0,11,CLIEN)) Q:'CLIEN D
... N ST,CDT
... ;
... ;Only retrieve closed cases
... S ST=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.07,"I") Q:ST'="C"
... S CDT=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.11,"I") Q:CDT=""
... S CLCASE(CDT,CLIEN)=""
.. ;
.. ;Loop through list and display
.. S CDT="" F S CDT=$O(CLCASE(CDT),-1) Q:CDT="" S BD1="" F S BD1=$O(CLCASE(CDT,BD1)) Q:'BD1 D
... S D0=BD1_","_VD0_","
... S ITEM=ITEM+1
... S CHOICES(ITEM)=DIC_U_VD0_U_BD1
... I ITEM=1 W ?0,ITEM_"."
... E W !,ITEM_"."
... N PIECE,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
..... W $S(DR=.02:$E($$GET1^DIQ(DIC,D0,DR),1,15),DR=.12:$E($$GET1^DIQ(DIC,D0,DR),1,29),1:$$GET1^DIQ(DIC,D0,DR))
.... I $P(EXECUTE,";",PIECE)'="" X $P(EXECUTE,";",PIECE)
.... I $P(POSTEXEC,";",PIECE)'="" X $P(POSTEXEC,";",PIECE)
...K PIECE,DR
S AG("N")=$G(ITEM)
W !,$G(AGLINE("-"))
;
Q
;
STAT(RD0,RD1) ;Erase Closed Status
K DIC,DR,DIE,DA,DD,DO
S DA(1)=RD0
S DA=RD1
S DIE="^AUPNBENR("_DA(1)_",11,"
S DR=".07////@"
D ^DIE
K DIC,DR,DIE,DA
Q
;
COMBY(RD0,RD1) ;Erase Completed By
K DIC,DR,DIE,DA,DD,DO
S DA(1)=RD0
S DA=RD1
S DIE="^AUPNBENR("_DA(1)_",11,"
S DR=".09////@"
D ^DIE
K DIC,DR,DIE,DA
Q
;
COMDT(RD0,RD1) ;Erase Date Completed
K DIC,DR,DIE,DA,DD,DO
S DA(1)=RD0
S DA=RD1
S DIE="^AUPNBENR("_DA(1)_",11,"
S DR=".11////@"
D ^DIE
K DIC,DR,DIE,DA
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 POSITION 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 CHOOSE THIS
; FLD ON THE SCREEN
; 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 ANOTHER IS POINTING TO.
; EXECUTED TO PRINT THE FLD. IF MUTLIPLE FLDS 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 FLD 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 ";"
;
;CLOSED CASES DISPLAY
2 ;
;;- BENEFITS COORDINATION
;;-================================================================================
;;-COMPLETED DATE CASE DATE ASSIGNED TO REASON
;;---------------------------------------------------------------------------------
;;^?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
;;*END*
AGEDBEI ; VNGT/HS/BEE - DISPLAY/EDIT CLOSED CASES ;
+1 ;;7.1;PATIENT REGISTRATION;**8**;AUG 25, 2005
+2 ;
+3 QUIT
+4 ;
CLS(DFN,CLOSED) NEW ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
+1 ;
VAR NEW CHOICES,DIR,DQOUT,Y
DRAW ;EP
+1 SET AG("PG")="5BEI"
+2 SET ROUTID=$PIECE($TEXT(+1)," ")
+3 ;SCREEN HEADER ROUTINE
DO ^AGED
+4 DO GETAW
+5 ;
+6 SET DIR("A")="Select 1-"_AG("N")
+7 SET DIR("?",1)="Enter the item number of the case you wish to reopen."
+8 SET DIR(0)="N^1:"_AG("N")_":0"
+9 ;
+10 ;
+11 DO READ^AGED1
+12 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!('+Y)
GOTO EXIT
+13 IF AG("N")=0
WRITE !,"There are no items to select!"
HANG 3
GOTO EXIT
+14 IF $DATA(DQOUT)!(+Y<1)!(+Y>AG("N"))!'$DATA(CHOICES(+Y))
WRITE !!,"You must enter a number from 1 to ",AG("N")
HANG 2
KILL AG,CHOICES,DIR,DQOUT,Y
GOTO VAR
+15 SET PARAM1=$PIECE(CHOICES(+Y),U,2)
SET PARAM2=$PIECE(CHOICES(+Y),U,3)
+16 ;
+17 ;Remove Closed Status
+18 DO STAT(PARAM1,PARAM2)
+19 ;
+20 ;Remove Completed By
+21 DO COMBY(PARAM1,PARAM2)
+22 ;
+23 ;Remove Date Completed
+24 DO COMDT(PARAM1,PARAM2)
+25 ;
+26 ;Update the registration
+27 DO UPDATE1^AGED(DUZ(2),DFN,3,"")
+28 ;
+29 ;Edit the Case
+30 SET DORTN="EN^AGEDBEB("_PARAM1_","_PARAM2_","_"0)"
DO @DORTN
KILL AG,CHOICES,DIR,DQOUT,Y
GOTO VAR
+31 ;
EXIT KILL ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
+1 KILL AG,CHOICES,DIR,DQOUT,Y
+2 QUIT
GETAW ;DISP
+1 NEW AUPNPAT,BD0,ITEM,AGSCRN
+2 SET AUPNPAT=$GET(DFN)
+3 IF AUPNPAT=""
WRITE !!,"PATIENT IEN NOT DEFINED!"
HANG 2
QUIT
+4 ;
+5 ;GET CASE IEN OF PATIENT THEN GET ALL CASES ASSIGNED TO BEN. COORD.
SET BD0=$ORDER(^AUPNBENR("B",AUPNPAT,""))
+6 KILL AG("C")
+7 SET ITEM=0
+8 FOR AG=1:1
Begin DoDot:1
+9 NEW CAPTION,CAPDENT,DIC,EXECUTE,ITEMNUM,NEWLINE,POSTEXEC,PRECAPEX,PREEXEC,TAGCALL,VD0,VDR
+10 ;OPTIONAL DISP
SET AGSCRN=$PIECE($TEXT(@2+AG),";;",2,15)
+11 IF AGSCRN[("*END*")
QUIT
+12 ;FLD CAP
SET CAPTION=$PIECE(AGSCRN,U)
+13 ;- DENOTES SECTION
IF $EXTRACT(CAPTION)="-"
WRITE !,$EXTRACT(CAPTION,2,199)
QUIT
+14 ;FILE OR SUBFILE #
SET DIC=$PIECE(AGSCRN,U,3)
+15 ;FLD #
SET VDR=$PIECE(AGSCRN,U,4)
+16 ;NEWLINE OR INDENT
SET NEWLINE=$PIECE(AGSCRN,U,5)
+17 ;CAP INDENT
SET CAPDENT=$PIECE(AGSCRN,U,2)
+18 ;ITEM #
SET ITEMNUM=$PIECE(AGSCRN,U,6)
+19 ;TAG TO CALL TO EDIT THIS FLD
SET TAGCALL=$PIECE($PIECE(AGSCRN,U,7),"|",1)
+20 ;USE TO DISP FLD WHICH IS DEPENDENT ON ANOTHER FLD
SET EXECUTE=$PIECE(AGSCRN,"|",2)
+21 ;PLACE CODE TO BE XECUTED PRIOR TO DISP OF THE FLD
SET PREEXEC=$PIECE(AGSCRN,"|",3)
+22 ;PLACE CODE TO EXECUTE BEF CAP/FLD LBL
SET PRECAPEX=$PIECE(AGSCRN,"|",4)
+23 ;PLACE CODE HERE TO BE EXECUTED AFT DISP OF THE FLD
SET POSTEXEC=$PIECE(AGSCRN,"|",5)
+24 ;SELECTION STRING
IF TAGCALL'=""
SET $PIECE(AG("C"),",",ITEMNUM)=TAGCALL
+25 WRITE @NEWLINE
+26 WRITE ITEMNUM
+27 WRITE $SELECT(ITEMNUM'="":". ",1:"")
+28 IF PRECAPEX=""
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,VDR,0)),U)_": ")
+29 IF PRECAPEX'=""
XECUTE PRECAPEX
IF $TEST
WRITE @CAPDENT,$SELECT($GET(CAPTION)'="":CAPTION_": ",$GET(CAPTION)="":"",1:$PIECE($GET(^DD(DIC,VDR,0)),U)_": ")
+30 ;
+31 SET VD0=BD0
+32 ;
+33 ;Pull Case Information
+34 ;
+35 IF DIC["9000044."
Begin DoDot:2
+36 NEW CDT,BD1,D0
+37 IF $GET(BD0)=""
SET BD0="NOREF"
+38 IF '$ORDER(^AUPNBENR(BD0,11,0))
WRITE !,"PATIENT HAS NO CASE DATE ENTRIES!",!
QUIT
+39 ;
+40 ;Get list of closed cases, sort by complete date
+41 NEW CLCASE,CLIEN
+42 SET CLIEN=0
FOR
SET CLIEN=$ORDER(^AUPNBENR(VD0,11,CLIEN))
IF 'CLIEN
QUIT
Begin DoDot:3
+43 NEW ST,CDT
+44 ;
+45 ;Only retrieve closed cases
+46 SET ST=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.07,"I")
IF ST'="C"
QUIT
+47 SET CDT=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.11,"I")
IF CDT=""
QUIT
+48 SET CLCASE(CDT,CLIEN)=""
End DoDot:3
+49 ;
+50 ;Loop through list and display
+51 SET CDT=""
FOR
SET CDT=$ORDER(CLCASE(CDT),-1)
IF CDT=""
QUIT
SET BD1=""
FOR
SET BD1=$ORDER(CLCASE(CDT,BD1))
IF 'BD1
QUIT
Begin DoDot:3
+52 SET D0=BD1_","_VD0_","
+53 SET ITEM=ITEM+1
+54 SET CHOICES(ITEM)=DIC_U_VD0_U_BD1
+55 IF ITEM=1
WRITE ?0,ITEM_"."
+56 IF '$TEST
WRITE !,ITEM_"."
+57 NEW PIECE,DR
+58 FOR PIECE=1:1
SET DR=$PIECE(VDR,";",PIECE)
IF DR=""
QUIT
Begin DoDot:4
+59 IF $PIECE(PREEXEC,";",PIECE)'=""
XECUTE $PIECE(PREEXEC,";",PIECE)
+60 IF $PIECE(EXECUTE,";",PIECE)=""
Begin DoDot:5
+61 WRITE $SELECT(DR=.02:$EXTRACT($$GET1^DIQ(DIC,D0,DR),1,15),DR=.12:$EXTRACT($$GET1^DIQ(DIC,D0,DR),1,29),1:$$GET1^DIQ(DIC,D0,DR))
End DoDot:5
+62 IF $PIECE(EXECUTE,";",PIECE)'=""
XECUTE $PIECE(EXECUTE,";",PIECE)
+63 IF $PIECE(POSTEXEC,";",PIECE)'=""
XECUTE $PIECE(POSTEXEC,";",PIECE)
End DoDot:4
+64 KILL PIECE,DR
End DoDot:3
End DoDot:2
End DoDot:1
IF $GET(AGSCRN)[("*END*")
QUIT
+65 SET AG("N")=$GET(ITEM)
+66 WRITE !,$GET(AGLINE("-"))
+67 ;
+68 QUIT
+69 ;
STAT(RD0,RD1) ;Erase Closed Status
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=RD0
+3 SET DA=RD1
+4 SET DIE="^AUPNBENR("_DA(1)_",11,"
+5 SET DR=".07////@"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
+9 ;
COMBY(RD0,RD1) ;Erase Completed By
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=RD0
+3 SET DA=RD1
+4 SET DIE="^AUPNBENR("_DA(1)_",11,"
+5 SET DR=".09////@"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
+9 ;
COMDT(RD0,RD1) ;Erase Date Completed
+1 KILL DIC,DR,DIE,DA,DD,DO
+2 SET DA(1)=RD0
+3 SET DA=RD1
+4 SET DIE="^AUPNBENR("_DA(1)_",11,"
+5 SET DR=".11////@"
+6 DO ^DIE
+7 KILL DIC,DR,DIE,DA
+8 QUIT
+9 ;
+10 ; ****************************************************************
+11 ; ON LINES BELOW:
+12 ; U "^" DELIMITED
+13 ; AGSCRN CONTAINS THE $TEXT OF EACH LINE BELOW STARTING AT TAG '1'
+14 ; PIECE VAR DESC
+15 ; ----- -------- -----------------------------------------------
+16 ; 1 CAPTION FLD CAP ASSIGNED BY PROGRAMMER OVERRIDES FLD LBL IF POPULATED
+17 ; 2 CAPDENT POSITION ON LINE TO DISP CAP
+18 ; 3 DIC FILE OR SUBFILE #
+19 ; 4 DR FLD # - THESE CAN BE SEPARATED BY ";" THIS ALLOWS
+20 ; MULTIPLE FLDS TO BE PRINTED WITH THE SAME CAP AS IN
+21 ; 'CITY,STATE,ZIP'
+22 ; 5 NEWLINE NEW LINE OR NOT (MUST BE EITHER A '!' OR '?#') USE THIS TO INDENT THE LINE
+23 ; 6 ITEMNUM ITEM # ASSIGNMENT. USE THIS TO ASSIGN THE ITEM # USED TO CHOOSE THIS
+24 ; FLD ON THE SCREEN
+25 ; 7 TAGCALL TAG TO CALL WHEN THIS FLD IS CHOSEN BY USER TO BE EDITED
+26 ;
+27 ; BAR "|" DELIMITED
+28 ; PIECE VAR DESC
+29 ; ----- -------- ----------------------------------------------
+30 ; 2 EXECUTE EXECUTE CODE TO GET FLD THAT ANOTHER IS POINTING TO.
+31 ; EXECUTED TO PRINT THE FLD. IF MUTLIPLE FLDS ARE PRINTED
+32 ; THEN MULTIPLE EXECUTE CODES CAN BE SEPARATED BY ";".
+33 ; 3 PREEXEC EXECUTE CODE TO DO BEF FLD PRINTS. USE TO SCREEN OUT
+34 ; PRINTING A FLD VALUE. FOR MULTIPLES SEPARATE BY ";"
+35 ; 4 PRECAPEX EXECUTE CODE TO DO BEF PRINTING THE CAP OR FLD LBL.
+36 ; USE TO SCREEN OUT PRINTING A CAP/FLD LBL
+37 ; 5 POSTEXEC EXECUTE CODE TO DO AFT PRINTING THE FLD DATA.
+38 ; FOR MULTIPLES SEPARATE BY ";"
+39 ;
+40 ;CLOSED CASES DISPLAY
2 ;
+1 ;;- BENEFITS COORDINATION
+2 ;;-================================================================================
+3 ;;-COMPLETED DATE CASE DATE ASSIGNED TO REASON
+4 ;;---------------------------------------------------------------------------------
+5 ;;^?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
+6 ;;*END*
