- QAOEDT2 ;HISC/DAD-MISC EDITS ;7/26/93 12:27
- ;;3.0;Occurrence Screen;;09/14/1993
- EN1 ; *** COMMITTEE EDIT
- S QALIMIT="I $P(^(0),""^"",11)'>0",QAOSPROG="1^QAOEDT2" D EN2^QAOEDT
- G EXIT
- 1 S QAOSWHAT="REVIEWED" D ENDISP^QAOUTL0
- K DR S DIE="^QA(741,",DR="17",DR(2,741.017)=".01;4;10",DA=QAOSD0
- D ^DIE S QAOSQUIT=$S($D(Y):1,1:0)
- S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="e"
- S QAUDIT("COMMENT")="COMMITTEE REVIEW, OTHER THAN QA COMMITTEE"
- D ^QAQAUDIT
- Q
- EN3 ; *** FINAL DISPOSITION
- S QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)=0,$O(^QA(741,+Y,""REVR"",0))"
- S QAOSPROG="3^QAOEDT2" D EN2^QAOEDT G EXIT
- 3 S QAOSWHAT="CLOSED OUT" D ENDISP^QAOUTL0
- K DR S DIE="^QA(741,",DR="14//TODAY;16;11//CLOSED",DA=QAOSD0
- D ^DIE S QAOSQUIT=$S($D(Y):1,1:0)
- S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="c"
- S QAUDIT("COMMENT")="CLOSE A RECORD" D ^QAQAUDIT
- Q
- EN4 ; *** DELETE
- W !!,"Do you wish to see a list of deleted occurrences"
- S %=2,LINE=1,QAOSQUIT=0 D YN^DICN Q:%=-1 G:%=2 DEL
- I '% W !!?3,"Please answer Y(es) or N(o)" G EN4
- W ! D WAIT^DICD W ! K ^TMP($J,"D")
- F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",2,QAOSD0)) Q:QAOSD0'>0 D
- . S LOC=^QA(741,QAOSD0,0),QAOSSCRN=+$G(^("SCRN")),QAOSWHO=+LOC
- . S QAOSDATE=$P(LOC,"^",3)
- . I $D(^DPT(QAOSWHO,0))#2 S QAOSWHO=$P(^(0),"^") D
- .. S QAOSSCRN=+^QA(741.1,QAOSSCRN,0)
- .. S ^TMP($J,"D",QAOSWHO,QAOSDATE,QAOSSCRN)=""
- .. Q
- . Q
- I $O(^TMP($J,"D",""))="" W !?5,"*** NO DELETED OCCURRENCES FOUND ***" G DEL
- S QAOSWHO="",LINE=$Y
- F S QAOSWHO=$O(^TMP($J,"D",QAOSWHO)) Q:QAOSWHO=""!QAOSQUIT F QADATE=0:0 S QADATE=$O(^TMP($J,"D",QAOSWHO,QADATE)) Q:QADATE'>0!QAOSQUIT F QAOSSCRN=0:0 S QAOSSCRN=$O(^TMP($J,"D",QAOSWHO,QADATE,QAOSSCRN)) Q:QAOSSCRN'>0!QAOSQUIT D
- . S Y=QADATE X ^DD("DD") W !?5,QAOSWHO,?30,Y,?50,QAOSSCRN
- . Q:$Y'>(IOSL+LINE-3)
- . K DIR S DIR(0)="E" D ^DIR K DIR
- . S QAOSQUIT=$S(Y'>0:1,1:0),LINE=$Y
- . Q
- DEL ;
- S QAOSPROG="DLT^QAOEDT2" D EN1^QAOEDT
- G EXIT
- DLT S QAOSWHAT="DELETED" D ENDISP^QAOUTL0 S (DIE,DIC)="^QA(741,"
- ASKDEL W !!?5,"Delete this record (Y/N) " S %=2
- D YN^DICN,YNOUT Q:%=2!QAOSQUIT
- I %=0 W !!?10,"Please answer Y(es) or N(o)" G ASKDEL
- S DR="11///^S X=2",DA=QAOSD0 D ^DIE
- S QAUDIT("FILE")="741^27",QAUDIT("DA")=DA,QAUDIT("ACTION")="d"
- S QAUDIT("COMMENT")="MARK A RECORD AS DELETED" D ^QAQAUDIT
- W !!?5,"*** RECORD HAS BEEN DELETED ***",*7,!
- Q
- ;
- EXIT ;
- K %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
- K QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSTYPE
- K QAOSONE,QAOSPROG
- K ^TMP($J,"D")
- Q
- DIEOUT S QAOSQUIT=$S($D(DTOUT):1,$D(DUOUT):1,$D(Y):1,1:0) Q
- YNOUT S QAOSQUIT=$S(%=-1:1,1:0) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOEDT2 2693 printed Feb 18, 2025@23:47:36 Page 2
- QAOEDT2 ;HISC/DAD-MISC EDITS ;7/26/93 12:27
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- EN1 ; *** COMMITTEE EDIT
- +1 SET QALIMIT="I $P(^(0),""^"",11)'>0"
- SET QAOSPROG="1^QAOEDT2"
- DO EN2^QAOEDT
- +2 GOTO EXIT
- 1 SET QAOSWHAT="REVIEWED"
- DO ENDISP^QAOUTL0
- +1 KILL DR
- SET DIE="^QA(741,"
- SET DR="17"
- SET DR(2,741.017)=".01;4;10"
- SET DA=QAOSD0
- +2 DO ^DIE
- SET QAOSQUIT=$SELECT($DATA(Y):1,1:0)
- +3 SET QAUDIT("FILE")="741^27"
- SET QAUDIT("DA")=QAOSD0
- SET QAUDIT("ACTION")="e"
- +4 SET QAUDIT("COMMENT")="COMMITTEE REVIEW, OTHER THAN QA COMMITTEE"
- +5 DO ^QAQAUDIT
- +6 QUIT
- EN3 ; *** FINAL DISPOSITION
- +1 SET QALIMIT="I +$P(^QA(741,+Y,0),""^"",11)=0,$O(^QA(741,+Y,""REVR"",0))"
- +2 SET QAOSPROG="3^QAOEDT2"
- DO EN2^QAOEDT
- GOTO EXIT
- 3 SET QAOSWHAT="CLOSED OUT"
- DO ENDISP^QAOUTL0
- +1 KILL DR
- SET DIE="^QA(741,"
- SET DR="14//TODAY;16;11//CLOSED"
- SET DA=QAOSD0
- +2 DO ^DIE
- SET QAOSQUIT=$SELECT($DATA(Y):1,1:0)
- +3 SET QAUDIT("FILE")="741^27"
- SET QAUDIT("DA")=QAOSD0
- SET QAUDIT("ACTION")="c"
- +4 SET QAUDIT("COMMENT")="CLOSE A RECORD"
- DO ^QAQAUDIT
- +5 QUIT
- EN4 ; *** DELETE
- +1 WRITE !!,"Do you wish to see a list of deleted occurrences"
- +2 SET %=2
- SET LINE=1
- SET QAOSQUIT=0
- DO YN^DICN
- if %=-1
- QUIT
- if %=2
- GOTO DEL
- +3 IF '%
- WRITE !!?3,"Please answer Y(es) or N(o)"
- GOTO EN4
- +4 WRITE !
- DO WAIT^DICD
- WRITE !
- KILL ^TMP($JOB,"D")
- +5 FOR QAOSD0=0:0
- SET QAOSD0=$ORDER(^QA(741,"AD",2,QAOSD0))
- if QAOSD0'>0
- QUIT
- Begin DoDot:1
- +6 SET LOC=^QA(741,QAOSD0,0)
- SET QAOSSCRN=+$GET(^("SCRN"))
- SET QAOSWHO=+LOC
- +7 SET QAOSDATE=$PIECE(LOC,"^",3)
- +8 IF $DATA(^DPT(QAOSWHO,0))#2
- SET QAOSWHO=$PIECE(^(0),"^")
- Begin DoDot:2
- +9 SET QAOSSCRN=+^QA(741.1,QAOSSCRN,0)
- +10 SET ^TMP($JOB,"D",QAOSWHO,QAOSDATE,QAOSSCRN)=""
- +11 QUIT
- End DoDot:2
- +12 QUIT
- End DoDot:1
- +13 IF $ORDER(^TMP($JOB,"D",""))=""
- WRITE !?5,"*** NO DELETED OCCURRENCES FOUND ***"
- GOTO DEL
- +14 SET QAOSWHO=""
- SET LINE=$Y
- +15 FOR
- SET QAOSWHO=$ORDER(^TMP($JOB,"D",QAOSWHO))
- if QAOSWHO=""!QAOSQUIT
- QUIT
- FOR QADATE=0:0
- SET QADATE=$ORDER(^TMP($JOB,"D",QAOSWHO,QADATE))
- if QADATE'>0!QAOSQUIT
- QUIT
- FOR QAOSSCRN=0:0
- SET QAOSSCRN=$ORDER(^TMP($JOB,"D",QAOSWHO,QADATE,QAOSSCRN))
- if QAOSSCRN'>0!QAOSQUIT
- QUIT
- Begin DoDot:1
- +16 SET Y=QADATE
- XECUTE ^DD("DD")
- WRITE !?5,QAOSWHO,?30,Y,?50,QAOSSCRN
- +17 if $Y'>(IOSL+LINE-3)
- QUIT
- +18 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +19 SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
- SET LINE=$Y
- +20 QUIT
- End DoDot:1
- DEL ;
- +1 SET QAOSPROG="DLT^QAOEDT2"
- DO EN1^QAOEDT
- +2 GOTO EXIT
- DLT SET QAOSWHAT="DELETED"
- DO ENDISP^QAOUTL0
- SET (DIE,DIC)="^QA(741,"
- ASKDEL WRITE !!?5,"Delete this record (Y/N) "
- SET %=2
- +1 DO YN^DICN
- DO YNOUT
- if %=2!QAOSQUIT
- QUIT
- +2 IF %=0
- WRITE !!?10,"Please answer Y(es) or N(o)"
- GOTO ASKDEL
- +3 SET DR="11///^S X=2"
- SET DA=QAOSD0
- DO ^DIE
- +4 SET QAUDIT("FILE")="741^27"
- SET QAUDIT("DA")=DA
- SET QAUDIT("ACTION")="d"
- +5 SET QAUDIT("COMMENT")="MARK A RECORD AS DELETED"
- DO ^QAQAUDIT
- +6 WRITE !!?5,"*** RECORD HAS BEEN DELETED ***",*7,!
- +7 QUIT
- +8 ;
- EXIT ;
- +1 KILL %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
- +2 KILL QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSTYPE
- +3 KILL QAOSONE,QAOSPROG
- +4 KILL ^TMP($JOB,"D")
- +5 QUIT
- DIEOUT SET QAOSQUIT=$SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,$DATA(Y):1,1:0)
- QUIT
- YNOUT SET QAOSQUIT=$SELECT(%=-1:1,1:0)
- QUIT
