ACHSBUG3 ; IHS/ITSC/PMF - EDIT MISSING AUTHORIZATION DATES ; [ 10/16/2001 8:16 AM ]
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
; - Check for missing 3-nodes and allow user to edit info.
;
; - A recurring bug deletes the 3-nodes, where the Beginning and
; Ending Authorization dates are kept. Current and previous
; developers have attempted to squash the bug, with no success.
;
N ACHSDUZ2,ACHSERR,ACHSFLAG,ACHSMIS3,ACHSVIEW,D,L
;
S ACHSVIEW=1,ACHSDUZ2=DUZ(2),(ACHSMIS3,L)=0
D HELP("HELPC3")
;
LOOP ;
S ACHSFLAG=$$DIR^XBDIR("SO^S:Search;D:Select an Individual Document","","","","^D HELP^ACHSBUG3(""HELPC3"")",2)
I ACHSFLAG="D" D SEL G LOOP
I ACHSFLAG="S" D SEARCH G LOOP
D EOJ
Q
;
SEARCH ;
F S L=$O(^ACHSF("B",L)) Q:'L!$D(DUOUT)!$D(DTOUT) S D=0 F S D=$O(^ACHSF(L,"D",D)) Q:'D!$D(DUOUT)!$D(DTOUT) W "." I '$D(^(D,3)) S ACHSMIS3=ACHSMIS3+1 D
. I '$$SETENVRN(L) D DISPLAY(L,D),EDIT(L,D)
;
Q
;
EOJ ;
W !,ACHSMIS3," documents processed."
N ACHSDOIT
S ACHSDOIT="S"_" DU"_"Z(2)="_ACHSDUZ2
X ACHSDOIT
D ^ACHSUF
I $$DIR^XBDIR("E","Press RETURN...")
Q
;
SETENVRN(L) ;
N ACHSDOIT
S ACHSDOIT="S"_" DU"_"Z(2)="_L
X ACHSDOIT
K L
N D
D ^ACHSUF
Q $G(ACHSERR)
;
DISPLAY(L,D) ;
N ACHSDOIT
S ACHSDOIT="S"_" DU"_"Z(2)="_L
X ACHSDOIT
;
S ACHSDIEN=D,ACHSTIEN=1
K ACHSSIG,D,L
D INIT^ACHSRP2,^ACHSAV
S ACHSADJ=""
D A0A^ACHSUSC
K ACHSADJ
Q
;
EDIT(L,D) ;
N DA,DIE,DR
S DIE="^ACHSF("_L_",""D"",",DA=D,DR="75;76"
K D,L
F D ^DIE Q:'$$DIR^XBDIR("Y","Edit again","N","","If you missed something, do you want to edit again (Y/N)","",1) D DISPLAY(+$P($P(DIE,"(",2),","),DA)
Q
;
SEL ;
D ^ACHSUD
Q:'$D(ACHSDIEN)
D DISPLAY(DUZ(2),ACHSDIEN)
I $P($G(^ACHSF(DUZ(2),"D",ACHSDIEN,3)),U,1) W !,*7,"AUTH BEGINNING DATE exists for this document." S X=$$DIR^XBDIR("E") Q:$D(DIRUT) G SEL
D EDIT(DUZ(2),ACHSDIEN)
Q
;
HELPC3 ;EP
;;You have the option of [S]earching for PDO's with missing beginning
;;authorization dates, or selecting a particular [D]ocument. In either
;;case, the document will be displayed, and you will be given the
;;opportunity to edit both the AUTH BEGINNING DATE and the AUTH ENDING
;;DATE. The AUTH BEGINNING DATE field is required. You can skip the
;;document by hatting out ("^"). You will be given the opportunity
;;of editing the dates, again, before proceeding to the next document.
;;###
;
HELP(L) ;EP - Display text at label L. Probably called from DIR.
W !
F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"
Q
;
ACHSBUG3 ; IHS/ITSC/PMF - EDIT MISSING AUTHORIZATION DATES ; [ 10/16/2001 8:16 AM ]
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 ; - Check for missing 3-nodes and allow user to edit info.
+4 ;
+5 ; - A recurring bug deletes the 3-nodes, where the Beginning and
+6 ; Ending Authorization dates are kept. Current and previous
+7 ; developers have attempted to squash the bug, with no success.
+8 ;
+9 NEW ACHSDUZ2,ACHSERR,ACHSFLAG,ACHSMIS3,ACHSVIEW,D,L
+10 ;
+11 SET ACHSVIEW=1
SET ACHSDUZ2=DUZ(2)
SET (ACHSMIS3,L)=0
+12 DO HELP("HELPC3")
+13 ;
LOOP ;
+1 SET ACHSFLAG=$$DIR^XBDIR("SO^S:Search;D:Select an Individual Document","","","","^D HELP^ACHSBUG3(""HELPC3"")",2)
+2 IF ACHSFLAG="D"
DO SEL
GOTO LOOP
+3 IF ACHSFLAG="S"
DO SEARCH
GOTO LOOP
+4 DO EOJ
+5 QUIT
+6 ;
SEARCH ;
+1 FOR
SET L=$ORDER(^ACHSF("B",L))
IF 'L!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
SET D=0
FOR
SET D=$ORDER(^ACHSF(L,"D",D))
IF 'D!$DATA(DUOUT)!$DATA(DTOUT)
QUIT
WRITE "."
IF '$DATA(^(D,3))
SET ACHSMIS3=ACHSMIS3+1
Begin DoDot:1
+2 IF '$$SETENVRN(L)
DO DISPLAY(L,D)
DO EDIT(L,D)
End DoDot:1
+3 ;
+4 QUIT
+5 ;
EOJ ;
+1 WRITE !,ACHSMIS3," documents processed."
+2 NEW ACHSDOIT
+3 SET ACHSDOIT="S"_" DU"_"Z(2)="_ACHSDUZ2
+4 XECUTE ACHSDOIT
+5 DO ^ACHSUF
+6 IF $$DIR^XBDIR("E","Press RETURN...")
+7 QUIT
+8 ;
SETENVRN(L) ;
+1 NEW ACHSDOIT
+2 SET ACHSDOIT="S"_" DU"_"Z(2)="_L
+3 XECUTE ACHSDOIT
+4 KILL L
+5 NEW D
+6 DO ^ACHSUF
+7 QUIT $GET(ACHSERR)
+8 ;
DISPLAY(L,D) ;
+1 NEW ACHSDOIT
+2 SET ACHSDOIT="S"_" DU"_"Z(2)="_L
+3 XECUTE ACHSDOIT
+4 ;
+5 SET ACHSDIEN=D
SET ACHSTIEN=1
+6 KILL ACHSSIG,D,L
+7 DO INIT^ACHSRP2
DO ^ACHSAV
+8 SET ACHSADJ=""
+9 DO A0A^ACHSUSC
+10 KILL ACHSADJ
+11 QUIT
+12 ;
EDIT(L,D) ;
+1 NEW DA,DIE,DR
+2 SET DIE="^ACHSF("_L_",""D"","
SET DA=D
SET DR="75;76"
+3 KILL D,L
+4 FOR
DO ^DIE
IF '$$DIR^XBDIR("Y","Edit again","N","","If you missed something, do you want to edit again (Y/N)","",1)
QUIT
DO DISPLAY(+$PIECE($PIECE(DIE,"(",2),","),DA)
+5 QUIT
+6 ;
SEL ;
+1 DO ^ACHSUD
+2 IF '$DATA(ACHSDIEN)
QUIT
+3 DO DISPLAY(DUZ(2),ACHSDIEN)
+4 IF $PIECE($GET(^ACHSF(DUZ(2),"D",ACHSDIEN,3)),U,1)
WRITE !,*7,"AUTH BEGINNING DATE exists for this document."
SET X=$$DIR^XBDIR("E")
IF $DATA(DIRUT)
QUIT
GOTO SEL
+5 DO EDIT(DUZ(2),ACHSDIEN)
+6 QUIT
+7 ;
HELPC3 ;EP
+1 ;;You have the option of [S]earching for PDO's with missing beginning
+2 ;;authorization dates, or selecting a particular [D]ocument. In either
+3 ;;case, the document will be displayed, and you will be given the
+4 ;;opportunity to edit both the AUTH BEGINNING DATE and the AUTH ENDING
+5 ;;DATE. The AUTH BEGINNING DATE field is required. You can skip the
+6 ;;document by hatting out ("^"). You will be given the opportunity
+7 ;;of editing the dates, again, before proceeding to the next document.
+8 ;;###
+9 ;
HELP(L) ;EP - Display text at label L. Probably called from DIR.
+1 WRITE !
+2 FOR %=1:1
WRITE !?4,$PIECE($TEXT(@L+%),";",3)
IF $PIECE($TEXT(@L+%+1),";",3)="###"
QUIT
+3 QUIT
+4 ;
