- ACHSRMVD ;IHS/OIT/FCJ - REMOVE DOC CAUSING THE DUPLICATE DOC ERROR;JUL 10, 2008
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,21**;JUN 11,2001;Build 43
- ;ACHS*3.1*13 IHS/OIT/FCJ NEW ROUTINE FOR PATCH 13
- ;ACHS*3.1*14 IHS/OIT/FCJ
- ST ;
- W @IOF
- W ?5,"This routine removes documents that have been added",!
- W ?5,"after the site manager has removed the entire fiscal",!
- W ?5,"year documents. You will need to enter the 4 digit",!
- W ?5,"fiscal year. The duplicate documents will then be",!
- W ?5,"displayed. You will need to confirm deletion of the",!
- W ?5,"documents.",!!
- W ?5,"NOTE: FY ON DISPLAYED DOCUMENTS SHOULD DISPLAY 10 YRS PRIOR TO FY ENTERED,",!
- W ?5,"EXAMPLE: IF 2008 ENTERED THEN THE FY: 1998 SHOULD DISPLAY FOR DOCUMENTS."
- W !
- FY ;Enter FY to remove documents from
- S DIR(0)="N^1996:"_ACHSCFY,DIR("A")="Enter the 4 digit FY the duplicate error is occurring in"
- D ^DIR K DIR
- G:$D(DIRUT) EXT
- G:Y<1 FY
- S ACHSEFY=Y
- ;
- PROC ; Beg process to display and delete documents
- ;ACHS*3.1*14 IHS/OIT/FCJ USER READ PROMPT AS CURRENT FY
- S (ACHSTMP,ACHSDOC)=""
- I '$D(^ACHS(9,DUZ(2),"FY",ACHSEFY)) W !,"This FY is not valid for this facility" G FY
- S (ACHSTMP,ACHSDOC)=1_$E(ACHSEFY,4)_"00000"+$P(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U) ;BEG DOC NUMBER
- ;I $D(^ACHS(9,DUZ(2),"FY",ACHSEFY)) S (ACHSTMP,ACHSDOC)=1_$E(ACHSEFY,4)_"00000"+$P(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U)
- ;I ACHSDOC="",ACHSEFY+10'>ACHSCFY S (ACHSTMP,ACHSDOC)=1_$E(ACHSEFY,4)_"00000"+$P(^ACHS(9,DUZ(2),"FY",ACHSEFY+10,"C"),U)
- W !,"Documents to be Removed:"
- S ACHSCTN=0,LISTCNT=1
- I ACHSDOC'="" D LOOP
- I LISTCNT=1 W !,"There are no documents to be removed...." D RTRN^ACHS G EXT
- S DIR(0)="Y",DIR("A")="Would you like to continue with deletion of these documents",DIR("B")="N"
- D ^DIR K DIR
- I Y=1 S ACHSCTN=1,LISTCNT=1 W !,"Deleting Documents: " D LOOP
- G EXT
- Q
- LOOP ;
- F S ACHSDOC=$O(^ACHSF(DUZ(2),"D","B",ACHSDOC)) Q:(ACHSDOC'?1N.N)!($E(ACHSDOC,2)>$E(ACHSEFY,4)) D
- . S ACHSDIEN=0
- . F S ACHSDIEN=$O(^ACHSF(DUZ(2),"D","B",ACHSDOC,ACHSDIEN)) Q:ACHSDIEN'?1N.N D
- . .D DSPL
- I ACHSCTN=1 W !,"Removed ",LISTCNT-1," Documents"
- S ACHSDOC=ACHSTMP
- Q
- DSPL ;Display document information
- ;ACHS*3.1*21 ADDED NXT 3 LINES FOR TESTING FOR INDX W/O DATA
- I '$D(^ACHSF(DUZ(2),"D",ACHSDIEN)) D Q
- .W !,"Index with no data ",ACHSDOC," Index removed",!
- .K ^ACHSF(DUZ(2),"D","B",ACHSDOC,ACHSDIEN)
- W !,LISTCNT,". Document: "
- S Y=ACHSDIEN D Q3^ACHSUD
- S Y=$P(DOCDATA,U,2) X ^DD("DD")
- W !?13," FY: ",$P(DOCDATA,U,27)," Date Entered: ",Y
- Q:'ACHSCTN
- DEL ;Delete the records
- S DIK="^ACHSF("_DUZ(2)_",""D"",",DA(1)=DUZ(2),DA=ACHSDIEN
- D ^DIK K DIK
- W " DELETED"
- Q
- EXT ;
- K ACHSDOC,ACHSTMP,ACHSCTN,ACHSDIEN,LISTCNT,DOCDATA,ACHSEFY
- Q
- ACHSRMVD ;IHS/OIT/FCJ - REMOVE DOC CAUSING THE DUPLICATE DOC ERROR;JUL 10, 2008
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**13,14,21**;JUN 11,2001;Build 43
- +2 ;ACHS*3.1*13 IHS/OIT/FCJ NEW ROUTINE FOR PATCH 13
- +3 ;ACHS*3.1*14 IHS/OIT/FCJ
- ST ;
- +1 WRITE @IOF
- +2 WRITE ?5,"This routine removes documents that have been added",!
- +3 WRITE ?5,"after the site manager has removed the entire fiscal",!
- +4 WRITE ?5,"year documents. You will need to enter the 4 digit",!
- +5 WRITE ?5,"fiscal year. The duplicate documents will then be",!
- +6 WRITE ?5,"displayed. You will need to confirm deletion of the",!
- +7 WRITE ?5,"documents.",!!
- +8 WRITE ?5,"NOTE: FY ON DISPLAYED DOCUMENTS SHOULD DISPLAY 10 YRS PRIOR TO FY ENTERED,",!
- +9 WRITE ?5,"EXAMPLE: IF 2008 ENTERED THEN THE FY: 1998 SHOULD DISPLAY FOR DOCUMENTS."
- +10 WRITE !
- FY ;Enter FY to remove documents from
- +1 SET DIR(0)="N^1996:"_ACHSCFY
- SET DIR("A")="Enter the 4 digit FY the duplicate error is occurring in"
- +2 DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- GOTO EXT
- +4 IF Y<1
- GOTO FY
- +5 SET ACHSEFY=Y
- +6 ;
- PROC ; Beg process to display and delete documents
- +1 ;ACHS*3.1*14 IHS/OIT/FCJ USER READ PROMPT AS CURRENT FY
- +2 SET (ACHSTMP,ACHSDOC)=""
- +3 IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHSEFY))
- WRITE !,"This FY is not valid for this facility"
- GOTO FY
- +4 ;BEG DOC NUMBER
- SET (ACHSTMP,ACHSDOC)=1_$EXTRACT(ACHSEFY,4)_"00000"+$PIECE(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U)
- +5 ;I $D(^ACHS(9,DUZ(2),"FY",ACHSEFY)) S (ACHSTMP,ACHSDOC)=1_$E(ACHSEFY,4)_"00000"+$P(^ACHS(9,DUZ(2),"FY",ACHSEFY,"C"),U)
- +6 ;I ACHSDOC="",ACHSEFY+10'>ACHSCFY S (ACHSTMP,ACHSDOC)=1_$E(ACHSEFY,4)_"00000"+$P(^ACHS(9,DUZ(2),"FY",ACHSEFY+10,"C"),U)
- +7 WRITE !,"Documents to be Removed:"
- +8 SET ACHSCTN=0
- SET LISTCNT=1
- +9 IF ACHSDOC'=""
- DO LOOP
- +10 IF LISTCNT=1
- WRITE !,"There are no documents to be removed...."
- DO RTRN^ACHS
- GOTO EXT
- +11 SET DIR(0)="Y"
- SET DIR("A")="Would you like to continue with deletion of these documents"
- SET DIR("B")="N"
- +12 DO ^DIR
- KILL DIR
- +13 IF Y=1
- SET ACHSCTN=1
- SET LISTCNT=1
- WRITE !,"Deleting Documents: "
- DO LOOP
- +14 GOTO EXT
- +15 QUIT
- LOOP ;
- +1 FOR
- SET ACHSDOC=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSDOC))
- IF (ACHSDOC'?1N.N)!($EXTRACT(ACHSDOC,2)>$EXTRACT(ACHSEFY,4))
- QUIT
- Begin DoDot:1
- +2 SET ACHSDIEN=0
- +3 FOR
- SET ACHSDIEN=$ORDER(^ACHSF(DUZ(2),"D","B",ACHSDOC,ACHSDIEN))
- IF ACHSDIEN'?1N.N
- QUIT
- Begin DoDot:2
- +4 DO DSPL
- End DoDot:2
- End DoDot:1
- +5 IF ACHSCTN=1
- WRITE !,"Removed ",LISTCNT-1," Documents"
- +6 SET ACHSDOC=ACHSTMP
- +7 QUIT
- DSPL ;Display document information
- +1 ;ACHS*3.1*21 ADDED NXT 3 LINES FOR TESTING FOR INDX W/O DATA
- +2 IF '$DATA(^ACHSF(DUZ(2),"D",ACHSDIEN))
- Begin DoDot:1
- +3 WRITE !,"Index with no data ",ACHSDOC," Index removed",!
- +4 KILL ^ACHSF(DUZ(2),"D","B",ACHSDOC,ACHSDIEN)
- End DoDot:1
- QUIT
- +5 WRITE !,LISTCNT,". Document: "
- +6 SET Y=ACHSDIEN
- DO Q3^ACHSUD
- +7 SET Y=$PIECE(DOCDATA,U,2)
- XECUTE ^DD("DD")
- +8 WRITE !?13," FY: ",$PIECE(DOCDATA,U,27)," Date Entered: ",Y
- +9 IF 'ACHSCTN
- QUIT
- DEL ;Delete the records
- +1 SET DIK="^ACHSF("_DUZ(2)_",""D"","
- SET DA(1)=DUZ(2)
- SET DA=ACHSDIEN
- +2 DO ^DIK
- KILL DIK
- +3 WRITE " DELETED"
- +4 QUIT
- EXT ;
- +1 KILL ACHSDOC,ACHSTMP,ACHSCTN,ACHSDIEN,LISTCNT,DOCDATA,ACHSEFY
- +2 QUIT
