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

AGEDBEI.m

Go to the documentation of this file. 
  1. AGEDBEI ; VNGT/HS/BEE - DISPLAY/EDIT CLOSED CASES ;    
  1.  ;;7.1;PATIENT REGISTRATION;**8**;AUG 25, 2005
  1.  ;
  1.  Q
  1.  ;
  1. CLS(DFN,CLOSED) N ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
  1.  ;
  1. VAR N CHOICES,DIR,DQOUT,Y
  1. DRAW ;EP
  1.  S AG("PG")="5BEI"
  1.  S ROUTID=$P($T(+1)," ")
  1.  D ^AGED  ;SCREEN HEADER ROUTINE
  1.  D GETAW
  1.  ;
  1.  S DIR("A")="Select 1-"_AG("N")
  1.  S DIR("?",1)="Enter the item number of the case you wish to reopen."
  1.  S DIR(0)="N^1:"_AG("N")_":0"
  1.  ;
  1.  ;
  1.  D READ^AGED1
  1.  G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!('+Y) EXIT
  1.  I AG("N")=0 W !,"There are no items to select!" H 3 G EXIT
  1.  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
  1.  S PARAM1=$P(CHOICES(+Y),U,2),PARAM2=$P(CHOICES(+Y),U,3)
  1.  ;
  1.  ;Remove Closed Status
  1.  D STAT(PARAM1,PARAM2)
  1.  ;
  1.  ;Remove Completed By
  1.  D COMBY(PARAM1,PARAM2)
  1.  ;
  1.  ;Remove Date Completed
  1.  D COMDT(PARAM1,PARAM2)
  1.  ;
  1.  ;Update the registration
  1.  D UPDATE1^AGED(DUZ(2),DFN,3,"")
  1.  ;
  1.  ;Edit the Case
  1.  S DORTN="EN^AGEDBEB("_PARAM1_","_PARAM2_","_"0)" D @DORTN K AG,CHOICES,DIR,DQOUT,Y G VAR
  1.  ;
  1. EXIT K ROUTID,DORTN,PARAM1,PARAM2,DTOUT,DUOUT,DIROUT
  1.  K AG,CHOICES,DIR,DQOUT,Y
  1.  Q
  1. GETAW ;DISP
  1.  N AUPNPAT,BD0,ITEM,AGSCRN
  1.  S AUPNPAT=$G(DFN)
  1.  I AUPNPAT="" W !!,"PATIENT IEN NOT DEFINED!" H 2 Q
  1.  ;
  1.  S BD0=$O(^AUPNBENR("B",AUPNPAT,""))  ;GET CASE IEN OF PATIENT THEN GET ALL CASES ASSIGNED TO BEN. COORD.
  1.  K AG("C")
  1.  S ITEM=0
  1.  F AG=1:1 D  Q:$G(AGSCRN)[("*END*")
  1.  . N CAPTION,CAPDENT,DIC,EXECUTE,ITEMNUM,NEWLINE,POSTEXEC,PRECAPEX,PREEXEC,TAGCALL,VD0,VDR
  1.  . S AGSCRN=$P($T(@2+AG),";;",2,15)  ;OPTIONAL DISP
  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.  . ;
  1.  . S VD0=BD0
  1.  . ;
  1.  . ;Pull Case Information
  1.  . ;
  1.  . I DIC["9000044."  D
  1.  .. N CDT,BD1,D0
  1.  .. I $G(BD0)="" S BD0="NOREF"
  1.  .. I '$O(^AUPNBENR(BD0,11,0)) W !,"PATIENT HAS NO CASE DATE ENTRIES!",! Q
  1.  .. ;
  1.  .. ;Get list of closed cases, sort by complete date
  1.  .. N CLCASE,CLIEN
  1.  .. S CLIEN=0 F  S CLIEN=$O(^AUPNBENR(VD0,11,CLIEN)) Q:'CLIEN  D
  1.  ... N ST,CDT
  1.  ... ;
  1.  ... ;Only retrieve closed cases
  1.  ... S ST=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.07,"I") Q:ST'="C"
  1.  ... S CDT=$$GET1^DIQ(9000044.11,CLIEN_","_VD0_",",.11,"I") Q:CDT=""
  1.  ... S CLCASE(CDT,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.  ... S D0=BD1_","_VD0_","
  1.  ... S ITEM=ITEM+1
  1.  ... S CHOICES(ITEM)=DIC_U_VD0_U_BD1
  1.  ... I ITEM=1 W ?0,ITEM_"."
  1.  ... E  W !,ITEM_"."
  1.  ... N PIECE,DR
  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,29),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,DR
  1.  S AG("N")=$G(ITEM)
  1.  W !,$G(AGLINE("-"))
  1.  ;
  1.  Q
  1.  ;
  1. STAT(RD0,RD1) ;Erase Closed Status
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA(1)=RD0
  1.  S DA=RD1
  1.  S DIE="^AUPNBENR("_DA(1)_",11,"
  1.  S DR=".07////@"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1.  ;
  1. COMBY(RD0,RD1) ;Erase Completed By
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA(1)=RD0
  1.  S DA=RD1
  1.  S DIE="^AUPNBENR("_DA(1)_",11,"
  1.  S DR=".09////@"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  1.  Q
  1.  ;
  1. COMDT(RD0,RD1) ;Erase Date Completed
  1.  K DIC,DR,DIE,DA,DD,DO
  1.  S DA(1)=RD0
  1.  S DA=RD1
  1.  S DIE="^AUPNBENR("_DA(1)_",11,"
  1.  S DR=".11////@"
  1.  D ^DIE
  1.  K DIC,DR,DIE,DA
  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.  ;CLOSED CASES DISPLAY
  1. 2 ;
  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.  ;;*END*