WVMGRP1 ;ISP/RFR - MANAGER'S PATIENT EDITS;Nov 09, 2018@14:45
;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
Q
DOCACT ;PROCESS DOCUMENT ACTIONS
;CALLED FROM PLSDATA^WVMGRP AND NOT INTENDED TO BE CALLED BY ANYTHING ELSE
N WVITEM,WVITEMS,WVDATA,WVERRORS,WVNODE,WVERROR,DIR,X,Y,DTOUT,DUOUT,DIROUT
N DIRUT,WVKEY,WVPNUM,WVTYPE,WVSTATUS
F D Q:$G(WVSTATUS)=0
.S WVSTATUS=$$ITEMS(.WVITEMS,.WVKEY,.WVPAT) I $G(WVITEMS)<1 S WVSTATUS=0 Q
.S WVTYPE=$P(WVSTATUS,U,2),$P(WVTYPE,U,2)=$S(WVTYPE="VISIT":"C",WVTYPE="DOCUMENT":"D",1:"")
.F D Q:$G(Y)<1
..I $G(WVITEMS)>1 D Q:+Y=-1
...W !," Applicable "_$$TITLE^XLFSTR($P(WVTYPE,U))_"s:",!
...F WVITEM=1:1:WVITEMS W $$LJ^XLFSTR(WVITEM,2)_" " F WVPNUM=1:1:$L(WVITEMS(WVKEY(WVITEM)),U) W $S(WVPNUM>1:" ",1:"")_$P(WVITEMS(WVKEY(WVITEM)),U,WVPNUM),!
...S DIR(0)="N"_U_"1:"_WVITEMS_":0"_U_"K:'$D(WVKEY(X)) X",DIR("A")=" Select "_$P(WVTYPE,U)
...S DIR("?")="Enter the number to the left of the "_$$LOW^XLFSTR($P(WVTYPE,U))_" you want to work with."
...D ^DIR
...I '$D(WVKEY(+Y)) S Y=-1 Q
...S WVITEM=WVKEY(+Y)
...W " "_$$STRIP^XLFSTR(WVITEMS(WVITEM),U),!
..I $G(WVITEMS)=1 D
...S WVITEM=$O(WVITEMS(0))
...W !," "_$P(WVTYPE,U)_": "
...F WVPNUM=1:1:$L(WVITEMS(WVITEM),U) W $P(WVITEMS(WVITEM),U,WVPNUM),!
..I $G(WVITEMS)<1 S Y=-2 Q
..N WVFIRST,WVRESULT,WVACTION S WVFIRST=1
..S WVNODE=0 F S WVNODE=$O(WVITEMS(WVITEM,WVNODE)) Q:'+WVNODE!($G(WVERROR)) D
...N WVCNT,WVRECID,WVRTACTS,WVFDA,WVCHAIN,WVCNUM,WVPSA,WVHELP,WVTXTA,WVTEXT
...I WVFIRST W !," L" S WVFIRST=0
...E W @IOF," Now l"
...W "et's work with the "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status.",!
...S WVRECID=$O(WVITEMS(WVITEM,WVNODE,0))
...I WVRECID<1 S WVERROR=$$ERROR^WVMGRP("determining the review record ID",,"There is a problem with the D cross-reference on the^WV DATA NEEDING REVIEW file.") Q
...I $G(WVACTION)'="" D Q:$G(WVERROR)!($G(WVPSA))
....S WVTEXT=" You previously "_$S($P(WVACTION,U,2)=1:"moved",1:"marked as entered in error")
....S WVTEXT=WVTEXT_" the "_$S($P(WVACTION,U)=4:"pregnancy",1:"lactation")_" status data"
....I $P(WVACTION,U,2)=1 S WVTEXT=WVTEXT_" from "_WVPAT("NAME")_" to "_$P(WVACTION,U,3)
....S WVTEXT=WVTEXT_"."
....D WRAP^ORUTL(WVTEXT,"WVTXTA",,,3,.WVCNT)
....S WVCNT=0 F S WVCNT=$O(WVTXTA(WVCNT)) Q:'+WVCNT W !,WVTXTA(WVCNT)
....S WVERROR=$$SHODATA Q:WVERROR=-1
....I WVERROR=2 D Q
.....W !," There is no longer any "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status data associated with this review"
.....W !," record and therefore, it will be ignored." H 5
.....S WVERROR=$$CROOTREC(WVRECID)
....K WVERROR
....S DIR(0)="Y"_U,DIR("A")="Do you want to perform the same action on the "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status"
....S WVTEXT=$E(WVTEXT,4,$L(WVTEXT))_" Review "_WVPAT("NAME")_"'s chart using CPRS to determine if the "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status displayed "
....S WVTEXT=WVTEXT_"above is still valid for "_WVPAT("NAME")_". If the status is still valid, enter "
....S WVTEXT=WVTEXT_"'N' for no (you do not want to mark the status as entered in error). If the "
....S WVTEXT=WVTEXT_"status is no longer valid, enter 'Y' for yes (you do want to mark the status "
....S WVTEXT=WVTEXT_"as entered in error)."
....D WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
....M DIR("?")=WVHELP S DIR("?")=DIR("?",WVCNT) K DIR("?",WVCNT)
....D ^DIR
....I $D(DIRUT)!($D(DIROUT)) S WVERROR=1 Q
....S WVPSA=+Y,WVRECID=+$O(^WV(790.8,WVRECID,1,0))_","_WVRECID_","
....S WVRESULT=$S(WVPSA:$$PACT^WVMGRP2(WVNODE,$P(WVACTION,U,2),WVRECID,$P(WVACTION,U,4),$P(WVACTION,U,5),$P(WVACTION,U,6),$P(WVACTION,U,7),$P(WVACTION,U,3)),1:$$CROOTREC($P(WVRECID,",",2)))
....I WVRESULT=-1 S WVERROR=-1 Q
...S WVRTACTS=0 F S WVRTACTS=$O(^WV(790.8,WVRECID,1,"AC",1,WVRTACTS)) Q:'+WVRTACTS!($G(WVERROR)) D
....S WVCNT=1+$G(WVCNT),WVRTACTS("B",WVCNT)=WVRTACTS_","_WVRECID_",",WVRTACTS("B")=WVCNT
....D GETS^DIQ(790.801,WVRTACTS("B",WVCNT),".01;2",,"WVDATA","WVERRORS")
....I $D(WVERRORS) S WVERROR=$$ERROR^WVMGRP("retrieving root-level activities",.WVERRORS) Q
....S WVRTACTS(WVRTACTS_","_WVRECID_",")=WVDATA(790.801,WVRTACTS("B",WVCNT),2)_" on "_WVDATA(790.801,WVRTACTS("B",WVCNT),.01)
...I '$D(WVRTACTS) S WVERROR=$$ERROR^WVMGRP("retrieving root-level activities",,"No root-level activities were found.") Q
...F Q:'$D(WVRTACTS("B"))!($G(WVERROR)) D
....I WVRTACTS("B")>1 D Q:$G(WVERROR)
.....W !," The following relevant actions were taken:",!!
.....S WVCNT=0 F S WVCNT=$O(WVRTACTS("B",WVCNT)) Q:'+WVCNT W ?5,$$RJ^XLFSTR(WVCNT," ",3),?11,WVRTACTS(WVRTACTS("B",WVCNT)),!
.....S DIR(0)="N"_U_U_"K:'$D(WVRTACTS(""B"",X)) X",DIR("A")="Select an action to review"
.....S DIR("?")="Enter the number to the left of the action you want to work with."
.....D ^DIR
.....I $D(DIRUT)!($D(DIROUT)) S WVERROR=1 Q
.....K DIR
.....S WVRTACTS=WVRTACTS("B",Y)_U_Y
.....W ?40,WVRTACTS(WVRTACTS("B",Y))
....I WVRTACTS("B")<2 S Y=$O(WVRTACTS("B",0)),WVRTACTS=WVRTACTS("B",Y)_U_Y
....S WVRESULT=$$BRANCH($P(WVRTACTS,U),.WVACTION)
....I $G(WVACTION)'="" S WVACTION=WVNODE_U_WVACTION
....I WVRESULT=-1 S WVERROR=-1 Q
....I WVRESULT=0 D
.....F WVCNUM=1:1:$L(WVCHAIN,U) S WVFDA(790.801,$P(WVCHAIN,U,WVCNUM),.01)="@"
.....D FILE^DIE("","WVFDA","WVERRORS")
.....I $D(WVERRORS) S WVERROR=$$ERROR^WVMGRP("deleting root activity chain",.WVERRORS) Q
.....I $O(^WV(790.8,WVRECID,1,0))="" S WVRESULT=$$CROOTREC(WVRECID) S:WVRESULT<1 WVERROR=-1 Q:$G(WVERROR)=-1
.....K WVRTACTS($P(WVRTACTS,U)),WVRTACTS("B",$P(WVRTACTS,U,2)),WVCHAIN
.....I $O(WVRTACTS("B",""))="" K WVRTACTS("B")
.....E S WVRTACTS("B")=WVRTACTS("B")-1
.....W !
..K WVITEMS(WVITEM),WVKEY
..S WVITEMS=WVITEMS-1
..I WVITEMS>0 S Y=1
..Q:WVITEMS<2
..S WVITEM=0 F S WVITEM=$O(WVITEMS(WVITEM)) Q:WVITEM="" S WVKEY=1+$G(WVKEY),WVKEY(WVKEY)=WVITEM
Q
;
VISITS(WVVISITS,WVKEY,WVVISIT) ;RETRIEVE SPECIFIED VISIT
N WVDATA,WVERRORS,WVRETURN
S WVRETURN=1
D GETS^DIQ(9000010,WVVISIT_",",".01;.22;15001","","WVDATA","WVERRORS")
I $D(WVERRORS),'$D(WVERRORS("DIERR","E",601)) S WVRETURN=$$ERROR^WVMGRP("retrieving available visits",.WVERRORS) Q
S WVVISITS=1+WVVISITS
I $D(WVERRORS("DIERR","E",601)) D
.S WVVISITS(WVVISIT)="#"_WVVISIT_" no longer exists."_U_U_U
.K WVERRORS
I $D(WVDATA) D
.S WVVISITS(WVVISIT)=$$RJ^XLFSTR(WVDATA(9000010,WVVISIT_",",.01),23)
.S WVVISITS(WVVISIT)=WVVISITS(WVVISIT)_U_$$RJ^XLFSTR($E(WVDATA(9000010,WVVISIT_",",.22),1,13),13)
.S WVVISITS(WVVISIT)=WVVISITS(WVVISIT)_U_$$REPEAT^XLFSTR(" ",10)_$$RJ^XLFSTR($E(WVDATA(9000010,WVVISIT_",",15001),1,12),12)
S WVKEY(WVVISITS)=WVVISIT
Q WVRETURN
DOCS(WVDOCS,WVKEY,WVDOC) ;RETRIEVE SPECIFIED DOCUMENT
N WVDATA,WVERRORS,WVRETURN
S WVRETURN=1
D GETS^DIQ(8925,WVDOC_",",".01;1201;1202","","WVDATA","WVERRORS")
I $D(WVERRORS) S WVRETURN=$$ERROR^WVMGRP("retrieving available documents",.WVERRORS) Q
S WVDOCS=1+WVDOCS
S WVDOCS(WVDOC)=$$LJ^XLFSTR(WVDATA(8925,WVDOC_",",1201),23)_$E(WVDATA(8925,WVDOC_",",.01),1,60)
S WVDOCS(WVDOC)=WVDOCS(WVDOC)_U_" "_$E(WVDATA(8925,WVDOC_",",1202),1,78)
S WVKEY(WVDOCS)=WVDOC
Q WVRETURN
ITEMS(WVITEMS,WVKEY,WVPAT) ;RETRIEVE EITHER DOCUMENTS OR VISITS FOR A PATIENT
N WVRETURN,WVITEM,WVINDEX
S WVINDEX=$S($D(^WV(790.8,"E",WVPAT))>9:"E",1:"D"),WVRETURN=1_U,WVITEMS=0
S WVITEM=0 F S WVITEM=$O(^WV(790.8,WVINDEX,WVPAT,WVITEM)) Q:'+WVITEM!($G(WVRETURN)=-1) D
.I WVINDEX="D" S WVRETURN=$$VISITS(.WVITEMS,.WVKEY,WVITEM)
.I WVINDEX="E" S WVRETURN=$$DOCS(.WVITEMS,.WVKEY,WVITEM)
.M WVITEMS(WVITEM)=^WV(790.8,WVINDEX,WVPAT,WVITEM)
I WVITEMS>0 S $P(WVRETURN,U,2)=$S(WVINDEX="E":"DOCUMENT",1:"VISIT")
Q WVRETURN
BRANCH(WVIEN,WVACT) ;PROCESS A BRANCH OF ACTIVITIES (DO NOT USE OUTSIDE OF THIS ROUTINE)
N WVRESULT,WVPIECE,WVAIEN
S WVCHAIN=WVIEN_$S($G(WVCHAIN)'="":U_WVCHAIN,1:""),WVRESULT=$$ACTIVTY(WVIEN)
I $P(WVRESULT,U)>0 D
.;TAKE ACTION
.S WVACT=WVRESULT,WVRESULT=$$PACT^WVMGRP2(WVNODE,$P(WVACT,U),WVIEN,$P(WVACT,U,3),$P(WVACT,U,4))
I WVRESULT=0 D
.;GO TO NEXT ACTIVITY IN CHAIN
.F WVPIECE=1:1:($L(WVIEN,",")-1) S WVAIEN(WVPIECE)=$P(WVIEN,",",WVPIECE)
.S WVAIEN=0 F S WVAIEN=$O(^WV(790.8,WVAIEN(2),1,WVAIEN(1),2,WVAIEN)) Q:'+WVAIEN!($G(WVRESULT)>0) D
..S WVRESULT=$$BRANCH($P($G(^WV(790.8,WVAIEN(2),1,WVAIEN(1),2,WVAIEN,0)),U)_","_WVAIEN(2)_",",.WVACT)
Q WVRESULT
;
ACTIVTY(WVIEN) ;PROCESS AN ACTIVITY (DO NOT USE OUTSIDE OF THIS ROUTINE)
; INPUT: WVIEN: IEN OF THE CURRENT ACTIVITY [REQUIRED]
; OUTPUT: $$ACTIVTY: WHAT THE USER WANTS TO DO
; 1 TO REASSIGN, 2 TO MARK ENTERED IN ERROR, 0 TO TAKE NO ACTION, -1 TO QUIT
N WVDATA,WVMSG,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,WVPT,WVRET,WVHELP,WVCNT,WVTEXT,WVRESULT,WVFDA,WVERRORS
D GETS^DIQ(790.801,WVIEN,"*","IE","WVDATA","WVMSG")
I $D(WVMSG) Q $$ERROR^WVMGRP("retrieving activity #"_WVIEN,.WVMSG)
S WVRESULT=$$SHODATA
Q:WVRESULT=-1 -1
W !," Activity Detail:",!,"ACTIVITY DATE/TIME: ",WVDATA(790.801,WVIEN,.01,"E"),!,?2,"ACTION: ",WVDATA(790.801,WVIEN,3,"E"),!
W ?2,"DOCUMENT NAME (IEN): ",WVDATA(790.801,WVIEN,2,"E"),!
I WVDATA(790.801,WVIEN,3,"E")="REASSIGN" S WVPT=WVDATA(790.801,WVIEN,11,"E") W ?2,"NEW PATIENT: ",WVPT,?40,"NEW VISIT: ",WVDATA(790.801,WVIEN,12,"E"),!
E S WVPT=WVPAT("NAME")
I WVRESULT=2 D Q 0
.W !," There is no longer any status data associated with this review",!," record and therefore, it will be ignored." H 5
W !," Please review the chart for "_WVPT_".",!,"Press ENTER to continue: "
R X:DTIME W !
I WVDATA(790.801,WVIEN,3,"E")="REASSIGN" D
.S DIR("A",1)="Do you want to move the "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status data",DIR("A")="from "_WVPAT("NAME")_" to "_WVDATA(790.801,WVIEN,11,"E")
.S WVRET=1_U_WVDATA(790.801,WVIEN,11,"E")_U_WVDATA(790.801,WVIEN,11,"I")_U_WVDATA(790.801,WVIEN,12,"I")_U_WVDATA(790.801,WVIEN,3,"E")_U_WVDATA(790.801,WVIEN,2,"E")_U_WVDATA(790.801,WVIEN,12,"E")
.S WVCNT=0
.S WVTEXT="Review both patients' charts using CPRS to determine which patient "
.S WVTEXT=WVTEXT_"("_WVPAT("NAME")_" or "_WVPT_") the status displayed above is valid for. "
.S WVTEXT=WVTEXT_"If the status is still valid for "_WVPAT("NAME")_", enter 'N' for no (you do "
.S WVTEXT=WVTEXT_"not want to move the status data to "_WVPT_"). If the status is valid for "
.S WVTEXT=WVTEXT_WVPT_", enter 'Y' for yes (you do want to move the status data to "_WVPT_")."
.D WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
.M DIR("?")=WVHELP S DIR("?")=DIR("?",WVCNT) K DIR("?",WVCNT)
I WVDATA(790.801,WVIEN,3,"E")'="REASSIGN" D
.S DIR("A",1)="Do you want to mark the "_$S(WVNODE=4:"pregnancy",1:"lactation")_" status data",DIR("A")="for "_WVPAT("NAME")_" as entered in error"
.S WVRET=2_U_U_U_U_WVDATA(790.801,WVIEN,3,"E")_U_WVDATA(790.801,WVIEN,2,"E")_U
.S WVCNT=0
.S WVTEXT="Review "_WVPT_"'s chart using CPRS to determine if the status displayed "
.S WVTEXT=WVTEXT_"above is still valid for "_WVPT_". If the status is still valid, enter "
.S WVTEXT=WVTEXT_"'N' for no (you do not want to mark the status as entered in error). If the "
.S WVTEXT=WVTEXT_"status is no longer valid, enter 'Y' for yes (you do want to mark the status "
.S WVTEXT=WVTEXT_"as entered in error)."
.D WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
.M DIR("?")=WVHELP S DIR("?")=DIR("?",WVCNT) K DIR("?",WVCNT)
S DIR(0)="Y"_U
D ^DIR
I $D(DIRUT)!($D(DIROUT)) Q -1
Q $S(+Y=1:WVRET,1:0)
;
SHODATA() ;DISPLAY STATUS DATA
N DIC,DA,DR,DIQ,WVERROR,WVMSG,WVENTRIS
I $G(WVTYPE)'="" D Q:$D(WVENTRIS)<10 2
.S DA=0 F S DA=$O(^WV(790,WVPAT,WVNODE,$P(WVTYPE,U,2),WVITEM,DA)) Q:'+DA S WVENTRIS(DA)=""
I $G(WVTYPE)="",$P(WVENTS(WVNODE,WVENTS("Y")),U)'="" S WVENTRIS($P(WVENTS(WVNODE,WVENTS("Y")),U))=""
I $D(WVENTRIS)<10 D Q WVERROR
.S WVMSG="There is an unknown problem with the selected status data."
.S WVERROR=$$ERROR^WVMGRP("displaying status data",,WVMSG)
S DIC="^WV(790,"_WVPAT_","_WVNODE_",",DA(1)=WVPAT
W !!," Status Data ("_WVPAT("NAME")_"):"
S DA=0 F S DA=$O(WVENTRIS(DA)) Q:'+DA D EN^DIQ
Q 1
;
CROOTREC(WVIEN) ;DELETE FILE #790.8 ENTRY
N WVFDA,WVERRORS,WVERROR
S WVFDA(790.8,WVIEN_",",.01)="@",WVERROR=1
D FILE^DIE("","WVFDA","WVERRORS")
I $D(WVERRORS) S WVERROR=$$ERROR^WVMGRP("deleting patient's review record",.WVERRORS)
Q WVERROR
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVMGRP1 12364 printed Sep 23, 2025@20:23:33 Page 2
WVMGRP1 ;ISP/RFR - MANAGER'S PATIENT EDITS;Nov 09, 2018@14:45
+1 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
+2 QUIT
DOCACT ;PROCESS DOCUMENT ACTIONS
+1 ;CALLED FROM PLSDATA^WVMGRP AND NOT INTENDED TO BE CALLED BY ANYTHING ELSE
+2 NEW WVITEM,WVITEMS,WVDATA,WVERRORS,WVNODE,WVERROR,DIR,X,Y,DTOUT,DUOUT,DIROUT
+3 NEW DIRUT,WVKEY,WVPNUM,WVTYPE,WVSTATUS
+4 FOR
Begin DoDot:1
+5 SET WVSTATUS=$$ITEMS(.WVITEMS,.WVKEY,.WVPAT)
IF $GET(WVITEMS)<1
SET WVSTATUS=0
QUIT
+6 SET WVTYPE=$PIECE(WVSTATUS,U,2)
SET $PIECE(WVTYPE,U,2)=$SELECT(WVTYPE="VISIT":"C",WVTYPE="DOCUMENT":"D",1:"")
+7 FOR
Begin DoDot:2
+8 IF $GET(WVITEMS)>1
Begin DoDot:3
+9 WRITE !," Applicable "_$$TITLE^XLFSTR($PIECE(WVTYPE,U))_"s:",!
+10 FOR WVITEM=1:1:WVITEMS
WRITE $$LJ^XLFSTR(WVITEM,2)_" "
FOR WVPNUM=1:1:$LENGTH(WVITEMS(WVKEY(WVITEM)),U)
WRITE $SELECT(WVPNUM>1:" ",1:"")_$PIECE(WVITEMS(WVKEY(WVITEM)),U,WVPNUM),!
+11 SET DIR(0)="N"_U_"1:"_WVITEMS_":0"_U_"K:'$D(WVKEY(X)) X"
SET DIR("A")=" Select "_$PIECE(WVTYPE,U)
+12 SET DIR("?")="Enter the number to the left of the "_$$LOW^XLFSTR($PIECE(WVTYPE,U))_" you want to work with."
+13 DO ^DIR
+14 IF '$DATA(WVKEY(+Y))
SET Y=-1
QUIT
+15 SET WVITEM=WVKEY(+Y)
+16 WRITE " "_$$STRIP^XLFSTR(WVITEMS(WVITEM),U),!
End DoDot:3
if +Y=-1
QUIT
+17 IF $GET(WVITEMS)=1
Begin DoDot:3
+18 SET WVITEM=$ORDER(WVITEMS(0))
+19 WRITE !," "_$PIECE(WVTYPE,U)_": "
+20 FOR WVPNUM=1:1:$LENGTH(WVITEMS(WVITEM),U)
WRITE $PIECE(WVITEMS(WVITEM),U,WVPNUM),!
End DoDot:3
+21 IF $GET(WVITEMS)<1
SET Y=-2
QUIT
+22 NEW WVFIRST,WVRESULT,WVACTION
SET WVFIRST=1
+23 SET WVNODE=0
FOR
SET WVNODE=$ORDER(WVITEMS(WVITEM,WVNODE))
if '+WVNODE!($GET(WVERROR))
QUIT
Begin DoDot:3
+24 NEW WVCNT,WVRECID,WVRTACTS,WVFDA,WVCHAIN,WVCNUM,WVPSA,WVHELP,WVTXTA,WVTEXT
+25 IF WVFIRST
WRITE !," L"
SET WVFIRST=0
+26 IF '$TEST
WRITE @IOF," Now l"
+27 WRITE "et's work with the "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status.",!
+28 SET WVRECID=$ORDER(WVITEMS(WVITEM,WVNODE,0))
+29 IF WVRECID<1
SET WVERROR=$$ERROR^WVMGRP("determining the review record ID",,"There is a problem with the D cross-reference on the^WV DATA NEEDING REVIEW file.")
QUIT
+30 IF $GET(WVACTION)'=""
Begin DoDot:4
+31 SET WVTEXT=" You previously "_$SELECT($PIECE(WVACTION,U,2)=1:"moved",1:"marked as entered in error")
+32 SET WVTEXT=WVTEXT_" the "_$SELECT($PIECE(WVACTION,U)=4:"pregnancy",1:"lactation")_" status data"
+33 IF $PIECE(WVACTION,U,2)=1
SET WVTEXT=WVTEXT_" from "_WVPAT("NAME")_" to "_$PIECE(WVACTION,U,3)
+34 SET WVTEXT=WVTEXT_"."
+35 DO WRAP^ORUTL(WVTEXT,"WVTXTA",,,3,.WVCNT)
+36 SET WVCNT=0
FOR
SET WVCNT=$ORDER(WVTXTA(WVCNT))
if '+WVCNT
QUIT
WRITE !,WVTXTA(WVCNT)
+37 SET WVERROR=$$SHODATA
if WVERROR=-1
QUIT
+38 IF WVERROR=2
Begin DoDot:5
+39 WRITE !," There is no longer any "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status data associated with this review"
+40 WRITE !," record and therefore, it will be ignored."
HANG 5
+41 SET WVERROR=$$CROOTREC(WVRECID)
End DoDot:5
QUIT
+42 KILL WVERROR
+43 SET DIR(0)="Y"_U
SET DIR("A")="Do you want to perform the same action on the "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status"
+44 SET WVTEXT=$EXTRACT(WVTEXT,4,$LENGTH(WVTEXT))_" Review "_WVPAT("NAME")_"'s chart using CPRS to determine if the "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status displayed "
+45 SET WVTEXT=WVTEXT_"above is still valid for "_WVPAT("NAME")_". If the status is still valid, enter "
+46 SET WVTEXT=WVTEXT_"'N' for no (you do not want to mark the status as entered in error). If the "
+47 SET WVTEXT=WVTEXT_"status is no longer valid, enter 'Y' for yes (you do want to mark the status "
+48 SET WVTEXT=WVTEXT_"as entered in error)."
+49 DO WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
+50 MERGE DIR("?")=WVHELP
SET DIR("?")=DIR("?",WVCNT)
KILL DIR("?",WVCNT)
+51 DO ^DIR
+52 IF $DATA(DIRUT)!($DATA(DIROUT))
SET WVERROR=1
QUIT
+53 SET WVPSA=+Y
SET WVRECID=+$ORDER(^WV(790.8,WVRECID,1,0))_","_WVRECID_","
+54 SET WVRESULT=$SELECT(WVPSA:$$PACT^WVMGRP2(WVNODE,$PIECE(WVACTION,U,2),WVRECID,$PIECE(WVACTION,U,4),$PIECE(WVACTION,U,5),$PIECE(WVACTION,U,6),$PIECE(WVACTION,U,7),$PIECE(WVACTION,U,3)),1:$$CROOTREC($PIECE(WVRECID,
",",2)))
+55 IF WVRESULT=-1
SET WVERROR=-1
QUIT
End DoDot:4
if $GET(WVERROR)!($GET(WVPSA))
QUIT
+56 SET WVRTACTS=0
FOR
SET WVRTACTS=$ORDER(^WV(790.8,WVRECID,1,"AC",1,WVRTACTS))
if '+WVRTACTS!($GET(WVERROR))
QUIT
Begin DoDot:4
+57 SET WVCNT=1+$GET(WVCNT)
SET WVRTACTS("B",WVCNT)=WVRTACTS_","_WVRECID_","
SET WVRTACTS("B")=WVCNT
+58 DO GETS^DIQ(790.801,WVRTACTS("B",WVCNT),".01;2",,"WVDATA","WVERRORS")
+59 IF $DATA(WVERRORS)
SET WVERROR=$$ERROR^WVMGRP("retrieving root-level activities",.WVERRORS)
QUIT
+60 SET WVRTACTS(WVRTACTS_","_WVRECID_",")=WVDATA(790.801,WVRTACTS("B",WVCNT),2)_" on "_WVDATA(790.801,WVRTACTS("B",WVCNT),.01)
End DoDot:4
+61 IF '$DATA(WVRTACTS)
SET WVERROR=$$ERROR^WVMGRP("retrieving root-level activities",,"No root-level activities were found.")
QUIT
+62 FOR
if '$DATA(WVRTACTS("B"))!($GET(WVERROR))
QUIT
Begin DoDot:4
+63 IF WVRTACTS("B")>1
Begin DoDot:5
+64 WRITE !," The following relevant actions were taken:",!!
+65 SET WVCNT=0
FOR
SET WVCNT=$ORDER(WVRTACTS("B",WVCNT))
if '+WVCNT
QUIT
WRITE ?5,$$RJ^XLFSTR(WVCNT," ",3),?11,WVRTACTS(WVRTACTS("B",WVCNT)),!
+66 SET DIR(0)="N"_U_U_"K:'$D(WVRTACTS(""B"",X)) X"
SET DIR("A")="Select an action to review"
+67 SET DIR("?")="Enter the number to the left of the action you want to work with."
+68 DO ^DIR
+69 IF $DATA(DIRUT)!($DATA(DIROUT))
SET WVERROR=1
QUIT
+70 KILL DIR
+71 SET WVRTACTS=WVRTACTS("B",Y)_U_Y
+72 WRITE ?40,WVRTACTS(WVRTACTS("B",Y))
End DoDot:5
if $GET(WVERROR)
QUIT
+73 IF WVRTACTS("B")<2
SET Y=$ORDER(WVRTACTS("B",0))
SET WVRTACTS=WVRTACTS("B",Y)_U_Y
+74 SET WVRESULT=$$BRANCH($PIECE(WVRTACTS,U),.WVACTION)
+75 IF $GET(WVACTION)'=""
SET WVACTION=WVNODE_U_WVACTION
+76 IF WVRESULT=-1
SET WVERROR=-1
QUIT
+77 IF WVRESULT=0
Begin DoDot:5
+78 FOR WVCNUM=1:1:$LENGTH(WVCHAIN,U)
SET WVFDA(790.801,$PIECE(WVCHAIN,U,WVCNUM),.01)="@"
+79 DO FILE^DIE("","WVFDA","WVERRORS")
+80 IF $DATA(WVERRORS)
SET WVERROR=$$ERROR^WVMGRP("deleting root activity chain",.WVERRORS)
QUIT
+81 IF $ORDER(^WV(790.8,WVRECID,1,0))=""
SET WVRESULT=$$CROOTREC(WVRECID)
if WVRESULT<1
SET WVERROR=-1
if $GET(WVERROR)=-1
QUIT
+82 KILL WVRTACTS($PIECE(WVRTACTS,U)),WVRTACTS("B",$PIECE(WVRTACTS,U,2)),WVCHAIN
+83 IF $ORDER(WVRTACTS("B",""))=""
KILL WVRTACTS("B")
+84 IF '$TEST
SET WVRTACTS("B")=WVRTACTS("B")-1
+85 WRITE !
End DoDot:5
End DoDot:4
End DoDot:3
+86 KILL WVITEMS(WVITEM),WVKEY
+87 SET WVITEMS=WVITEMS-1
+88 IF WVITEMS>0
SET Y=1
+89 if WVITEMS<2
QUIT
+90 SET WVITEM=0
FOR
SET WVITEM=$ORDER(WVITEMS(WVITEM))
if WVITEM=""
QUIT
SET WVKEY=1+$GET(WVKEY)
SET WVKEY(WVKEY)=WVITEM
End DoDot:2
if $GET(Y)<1
QUIT
End DoDot:1
if $GET(WVSTATUS)=0
QUIT
+91 QUIT
+92 ;
VISITS(WVVISITS,WVKEY,WVVISIT) ;RETRIEVE SPECIFIED VISIT
+1 NEW WVDATA,WVERRORS,WVRETURN
+2 SET WVRETURN=1
+3 DO GETS^DIQ(9000010,WVVISIT_",",".01;.22;15001","","WVDATA","WVERRORS")
+4 IF $DATA(WVERRORS)
IF '$DATA(WVERRORS("DIERR","E",601))
SET WVRETURN=$$ERROR^WVMGRP("retrieving available visits",.WVERRORS)
QUIT
+5 SET WVVISITS=1+WVVISITS
+6 IF $DATA(WVERRORS("DIERR","E",601))
Begin DoDot:1
+7 SET WVVISITS(WVVISIT)="#"_WVVISIT_" no longer exists."_U_U_U
+8 KILL WVERRORS
End DoDot:1
+9 IF $DATA(WVDATA)
Begin DoDot:1
+10 SET WVVISITS(WVVISIT)=$$RJ^XLFSTR(WVDATA(9000010,WVVISIT_",",.01),23)
+11 SET WVVISITS(WVVISIT)=WVVISITS(WVVISIT)_U_$$RJ^XLFSTR($EXTRACT(WVDATA(9000010,WVVISIT_",",.22),1,13),13)
+12 SET WVVISITS(WVVISIT)=WVVISITS(WVVISIT)_U_$$REPEAT^XLFSTR(" ",10)_$$RJ^XLFSTR($EXTRACT(WVDATA(9000010,WVVISIT_",",15001),1,12),12)
End DoDot:1
+13 SET WVKEY(WVVISITS)=WVVISIT
+14 QUIT WVRETURN
DOCS(WVDOCS,WVKEY,WVDOC) ;RETRIEVE SPECIFIED DOCUMENT
+1 NEW WVDATA,WVERRORS,WVRETURN
+2 SET WVRETURN=1
+3 DO GETS^DIQ(8925,WVDOC_",",".01;1201;1202","","WVDATA","WVERRORS")
+4 IF $DATA(WVERRORS)
SET WVRETURN=$$ERROR^WVMGRP("retrieving available documents",.WVERRORS)
QUIT
+5 SET WVDOCS=1+WVDOCS
+6 SET WVDOCS(WVDOC)=$$LJ^XLFSTR(WVDATA(8925,WVDOC_",",1201),23)_$EXTRACT(WVDATA(8925,WVDOC_",",.01),1,60)
+7 SET WVDOCS(WVDOC)=WVDOCS(WVDOC)_U_" "_$EXTRACT(WVDATA(8925,WVDOC_",",1202),1,78)
+8 SET WVKEY(WVDOCS)=WVDOC
+9 QUIT WVRETURN
ITEMS(WVITEMS,WVKEY,WVPAT) ;RETRIEVE EITHER DOCUMENTS OR VISITS FOR A PATIENT
+1 NEW WVRETURN,WVITEM,WVINDEX
+2 SET WVINDEX=$SELECT($DATA(^WV(790.8,"E",WVPAT))>9:"E",1:"D")
SET WVRETURN=1_U
SET WVITEMS=0
+3 SET WVITEM=0
FOR
SET WVITEM=$ORDER(^WV(790.8,WVINDEX,WVPAT,WVITEM))
if '+WVITEM!($GET(WVRETURN)=-1)
QUIT
Begin DoDot:1
+4 IF WVINDEX="D"
SET WVRETURN=$$VISITS(.WVITEMS,.WVKEY,WVITEM)
+5 IF WVINDEX="E"
SET WVRETURN=$$DOCS(.WVITEMS,.WVKEY,WVITEM)
+6 MERGE WVITEMS(WVITEM)=^WV(790.8,WVINDEX,WVPAT,WVITEM)
End DoDot:1
+7 IF WVITEMS>0
SET $PIECE(WVRETURN,U,2)=$SELECT(WVINDEX="E":"DOCUMENT",1:"VISIT")
+8 QUIT WVRETURN
BRANCH(WVIEN,WVACT) ;PROCESS A BRANCH OF ACTIVITIES (DO NOT USE OUTSIDE OF THIS ROUTINE)
+1 NEW WVRESULT,WVPIECE,WVAIEN
+2 SET WVCHAIN=WVIEN_$SELECT($GET(WVCHAIN)'="":U_WVCHAIN,1:"")
SET WVRESULT=$$ACTIVTY(WVIEN)
+3 IF $PIECE(WVRESULT,U)>0
Begin DoDot:1
+4 ;TAKE ACTION
+5 SET WVACT=WVRESULT
SET WVRESULT=$$PACT^WVMGRP2(WVNODE,$PIECE(WVACT,U),WVIEN,$PIECE(WVACT,U,3),$PIECE(WVACT,U,4))
End DoDot:1
+6 IF WVRESULT=0
Begin DoDot:1
+7 ;GO TO NEXT ACTIVITY IN CHAIN
+8 FOR WVPIECE=1:1:($LENGTH(WVIEN,",")-1)
SET WVAIEN(WVPIECE)=$PIECE(WVIEN,",",WVPIECE)
+9 SET WVAIEN=0
FOR
SET WVAIEN=$ORDER(^WV(790.8,WVAIEN(2),1,WVAIEN(1),2,WVAIEN))
if '+WVAIEN!($GET(WVRESULT)>0)
QUIT
Begin DoDot:2
+10 SET WVRESULT=$$BRANCH($PIECE($GET(^WV(790.8,WVAIEN(2),1,WVAIEN(1),2,WVAIEN,0)),U)_","_WVAIEN(2)_",",.WVACT)
End DoDot:2
End DoDot:1
+11 QUIT WVRESULT
+12 ;
ACTIVTY(WVIEN) ;PROCESS AN ACTIVITY (DO NOT USE OUTSIDE OF THIS ROUTINE)
+1 ; INPUT: WVIEN: IEN OF THE CURRENT ACTIVITY [REQUIRED]
+2 ; OUTPUT: $$ACTIVTY: WHAT THE USER WANTS TO DO
+3 ; 1 TO REASSIGN, 2 TO MARK ENTERED IN ERROR, 0 TO TAKE NO ACTION, -1 TO QUIT
+4 NEW WVDATA,WVMSG,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,WVPT,WVRET,WVHELP,WVCNT,WVTEXT,WVRESULT,WVFDA,WVERRORS
+5 DO GETS^DIQ(790.801,WVIEN,"*","IE","WVDATA","WVMSG")
+6 IF $DATA(WVMSG)
QUIT $$ERROR^WVMGRP("retrieving activity #"_WVIEN,.WVMSG)
+7 SET WVRESULT=$$SHODATA
+8 if WVRESULT=-1
QUIT -1
+9 WRITE !," Activity Detail:",!,"ACTIVITY DATE/TIME: ",WVDATA(790.801,WVIEN,.01,"E"),!,?2,"ACTION: ",WVDATA(790.801,WVIEN,3,"E"),!
+10 WRITE ?2,"DOCUMENT NAME (IEN): ",WVDATA(790.801,WVIEN,2,"E"),!
+11 IF WVDATA(790.801,WVIEN,3,"E")="REASSIGN"
SET WVPT=WVDATA(790.801,WVIEN,11,"E")
WRITE ?2,"NEW PATIENT: ",WVPT,?40,"NEW VISIT: ",WVDATA(790.801,WVIEN,12,"E"),!
+12 IF '$TEST
SET WVPT=WVPAT("NAME")
+13 IF WVRESULT=2
Begin DoDot:1
+14 WRITE !," There is no longer any status data associated with this review",!," record and therefore, it will be ignored."
HANG 5
End DoDot:1
QUIT 0
+15 WRITE !," Please review the chart for "_WVPT_".",!,"Press ENTER to continue: "
+16 READ X:DTIME
WRITE !
+17 IF WVDATA(790.801,WVIEN,3,"E")="REASSIGN"
Begin DoDot:1
+18 SET DIR("A",1)="Do you want to move the "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status data"
SET DIR("A")="from "_WVPAT("NAME")_" to "_WVDATA(790.801,WVIEN,11,"E")
+19 SET WVRET=1_U_WVDATA(790.801,WVIEN,11,"E")_U_WVDATA(790.801,WVIEN,11,"I")_U_WVDATA(790.801,WVIEN,12,"I")_U_WVDATA(790.801,WVIEN,3,"E")_U_WVDATA(790.801,WVIEN,2,"E")_U_WVDATA(790.801,WVIEN,12,"E")
+20 SET WVCNT=0
+21 SET WVTEXT="Review both patients' charts using CPRS to determine which patient "
+22 SET WVTEXT=WVTEXT_"("_WVPAT("NAME")_" or "_WVPT_") the status displayed above is valid for. "
+23 SET WVTEXT=WVTEXT_"If the status is still valid for "_WVPAT("NAME")_", enter 'N' for no (you do "
+24 SET WVTEXT=WVTEXT_"not want to move the status data to "_WVPT_"). If the status is valid for "
+25 SET WVTEXT=WVTEXT_WVPT_", enter 'Y' for yes (you do want to move the status data to "_WVPT_")."
+26 DO WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
+27 MERGE DIR("?")=WVHELP
SET DIR("?")=DIR("?",WVCNT)
KILL DIR("?",WVCNT)
End DoDot:1
+28 IF WVDATA(790.801,WVIEN,3,"E")'="REASSIGN"
Begin DoDot:1
+29 SET DIR("A",1)="Do you want to mark the "_$SELECT(WVNODE=4:"pregnancy",1:"lactation")_" status data"
SET DIR("A")="for "_WVPAT("NAME")_" as entered in error"
+30 SET WVRET=2_U_U_U_U_WVDATA(790.801,WVIEN,3,"E")_U_WVDATA(790.801,WVIEN,2,"E")_U
+31 SET WVCNT=0
+32 SET WVTEXT="Review "_WVPT_"'s chart using CPRS to determine if the status displayed "
+33 SET WVTEXT=WVTEXT_"above is still valid for "_WVPT_". If the status is still valid, enter "
+34 SET WVTEXT=WVTEXT_"'N' for no (you do not want to mark the status as entered in error). If the "
+35 SET WVTEXT=WVTEXT_"status is no longer valid, enter 'Y' for yes (you do want to mark the status "
+36 SET WVTEXT=WVTEXT_"as entered in error)."
+37 DO WRAP^ORUTL(WVTEXT,"WVHELP",0,,,.WVCNT)
+38 MERGE DIR("?")=WVHELP
SET DIR("?")=DIR("?",WVCNT)
KILL DIR("?",WVCNT)
End DoDot:1
+39 SET DIR(0)="Y"_U
+40 DO ^DIR
+41 IF $DATA(DIRUT)!($DATA(DIROUT))
QUIT -1
+42 QUIT $SELECT(+Y=1:WVRET,1:0)
+43 ;
SHODATA() ;DISPLAY STATUS DATA
+1 NEW DIC,DA,DR,DIQ,WVERROR,WVMSG,WVENTRIS
+2 IF $GET(WVTYPE)'=""
Begin DoDot:1
+3 SET DA=0
FOR
SET DA=$ORDER(^WV(790,WVPAT,WVNODE,$PIECE(WVTYPE,U,2),WVITEM,DA))
if '+DA
QUIT
SET WVENTRIS(DA)=""
End DoDot:1
if $DATA(WVENTRIS)<10
QUIT 2
+4 IF $GET(WVTYPE)=""
IF $PIECE(WVENTS(WVNODE,WVENTS("Y")),U)'=""
SET WVENTRIS($PIECE(WVENTS(WVNODE,WVENTS("Y")),U))=""
+5 IF $DATA(WVENTRIS)<10
Begin DoDot:1
+6 SET WVMSG="There is an unknown problem with the selected status data."
+7 SET WVERROR=$$ERROR^WVMGRP("displaying status data",,WVMSG)
End DoDot:1
QUIT WVERROR
+8 SET DIC="^WV(790,"_WVPAT_","_WVNODE_","
SET DA(1)=WVPAT
+9 WRITE !!," Status Data ("_WVPAT("NAME")_"):"
+10 SET DA=0
FOR
SET DA=$ORDER(WVENTRIS(DA))
if '+DA
QUIT
DO EN^DIQ
+11 QUIT 1
+12 ;
CROOTREC(WVIEN) ;DELETE FILE #790.8 ENTRY
+1 NEW WVFDA,WVERRORS,WVERROR
+2 SET WVFDA(790.8,WVIEN_",",.01)="@"
SET WVERROR=1
+3 DO FILE^DIE("","WVFDA","WVERRORS")
+4 IF $DATA(WVERRORS)
SET WVERROR=$$ERROR^WVMGRP("deleting patient's review record",.WVERRORS)
+5 QUIT WVERROR
+6 ;
