- 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 ;
