WVPROC1 ;HCIOFO/FT,JR IHS/ANMC/MWR - WV ADD/EDIT WV PROCEDURE; ;1/26/01 15:12
;;1.0;WOMEN'S HEALTH;**14**;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY WVPROC.
;
;
EDIT2(DA,WVPOP) ;EP
;---> EDIT A PROCEDURE.
;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
S WVPOP=0
I '$G(DA) D D OUT^WVUTL3 Q
.W !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
I '$D(^WV(790.1,DA,0)) D D OUT^WVUTL3 Q
.W !,"^WV(790.1, NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
S WVDFN=$P(^WV(790.1,DA,0),U,2)
D SCREEN(DA,.WVPOP)
;---> IF ENTRY WAS LOCKED, WVPOP=1.
Q:WVPOP
Q
;
SCREEN(DA,WVPOP) ;EP
;---> EDIT A PROCEDURE WITH SCREENMAN.
;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
;---> STORE OLD ZERO NODE VALUES IN WVOLD TO COMPARE FOR EDITS,
;---> STORE OLD 2 NODE VALUES IN WVOLD2.
;
N WVOLD,WVOLD2,WVPCDN,DDSFILE,DR,Y
S DDSFILE=790.1
S WVOLD=^WV(790.1,DA,0) S:$D(^(2)) WVOLD2=^WV(790.1,DA,2)
S WVPCDN=$P(WVOLD,U,4)
;
;---> SET DR=TO THE APPROPRIATE FORM.
D
.;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
.I $$COLP^WVUTL4(DA) S DR="[WV PROC-FORM-2-COLP]" Q
.;
.;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
.S DR="[WV PROC-FORM-1]"
;
;---> CALL SCREENMAN.
D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
Q:WVPOP
Q
;
;
FOLLOWUP(WVDA) ;EP
;---> PROCEDURE FOLLOW-UP MENU.
;---> REQUIRED VARIABLES: WVDA=IEN IN PROCEDURE FILE.
;---> WVLOOP TELLS WVNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
Q ;dead code?
;
NORMAL ;EP
;---> IF RESULT IS NORMAL, ASK TO QUEUE NORMAL PAP/MAM LETTER.
;---> QUIT IF VARIABLES NOT ADEQUATE.
N DIR,DIRUT,WVSPEC,WVSPTX,X,Y
Q:'$G(WVPCDN)!('$G(WVRESN))!('$D(WVACCN))
;
;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
Q:$P(^WV(790.31,WVRESN,0),U,21)
;
;---> FOR PAP WVSPEC=1, FOR ANY TYPE OF MAM WVSPEC=2, OTHERWISE 0.
S WVSPEC=$S(WVPCDN=1:1,$$PMAM^WVUTL6(WVPCDN):2,1:0)
;---> QUIT IF NOT A PAP OR MAM.
Q:'WVSPEC
;
;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
Q:'$D(^WV(790.02,DUZ(2),0))
Q:WVSPEC=1&('$P(^WV(790.02,DUZ(2),0),U,3))
Q:WVSPEC=2&('$P(^WV(790.02,DUZ(2),0),U,7))
;
;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
I $D(^WV(790.4,"C",WVACCN)) Q ;D Q
;.W !!
;.W ?5,"* (One or more Notifications already exist for this Procedure.)"
;
;---> SET TEXT.
S WVSPTX=$S(WVSPEC=1:"PAP",WVSPEC=2:"MAM",1:"?")
W !!!
S DIR("A")="QUEUE a "_WVSPTX_" Result Normal letter to be sent to this patient"
S DIR(0)="Y"
D ^DIR
Q:$D(DIRUT)!(Y=0)
D NORMALL^WVNOTIF1(WVDFN,WVACCN,WVSPEC,WVSPTX)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVPROC1 2838 printed Dec 13, 2024@02:47:26 Page 2
WVPROC1 ;HCIOFO/FT,JR IHS/ANMC/MWR - WV ADD/EDIT WV PROCEDURE; ;1/26/01 15:12
+1 ;;1.0;WOMEN'S HEALTH;**14**;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY WVPROC.
+4 ;
+5 ;
EDIT2(DA,WVPOP) ;EP
+1 ;---> EDIT A PROCEDURE.
+2 ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
+3 SET WVPOP=0
+4 IF '$GET(DA)
Begin DoDot:1
+5 WRITE !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
End DoDot:1
DO OUT^WVUTL3
QUIT
+6 IF '$DATA(^WV(790.1,DA,0))
Begin DoDot:1
+7 WRITE !,"^WV(790.1, NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
End DoDot:1
DO OUT^WVUTL3
QUIT
+8 SET WVDFN=$PIECE(^WV(790.1,DA,0),U,2)
+9 DO SCREEN(DA,.WVPOP)
+10 ;---> IF ENTRY WAS LOCKED, WVPOP=1.
+11 if WVPOP
QUIT
+12 QUIT
+13 ;
SCREEN(DA,WVPOP) ;EP
+1 ;---> EDIT A PROCEDURE WITH SCREENMAN.
+2 ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
+3 ;---> STORE OLD ZERO NODE VALUES IN WVOLD TO COMPARE FOR EDITS,
+4 ;---> STORE OLD 2 NODE VALUES IN WVOLD2.
+5 ;
+6 NEW WVOLD,WVOLD2,WVPCDN,DDSFILE,DR,Y
+7 SET DDSFILE=790.1
+8 SET WVOLD=^WV(790.1,DA,0)
if $DATA(^(2))
SET WVOLD2=^WV(790.1,DA,2)
+9 SET WVPCDN=$PIECE(WVOLD,U,4)
+10 ;
+11 ;---> SET DR=TO THE APPROPRIATE FORM.
+12 Begin DoDot:1
+13 ;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
+14 IF $$COLP^WVUTL4(DA)
SET DR="[WV PROC-FORM-2-COLP]"
QUIT
+15 ;
+16 ;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
+17 SET DR="[WV PROC-FORM-1]"
End DoDot:1
+18 ;
+19 ;---> CALL SCREENMAN.
+20 DO DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
+21 if WVPOP
QUIT
+22 QUIT
+23 ;
+24 ;
FOLLOWUP(WVDA) ;EP
+1 ;---> PROCEDURE FOLLOW-UP MENU.
+2 ;---> REQUIRED VARIABLES: WVDA=IEN IN PROCEDURE FILE.
+3 ;---> WVLOOP TELLS WVNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
+4 ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
+5 ;dead code?
QUIT
+6 ;
NORMAL ;EP
+1 ;---> IF RESULT IS NORMAL, ASK TO QUEUE NORMAL PAP/MAM LETTER.
+2 ;---> QUIT IF VARIABLES NOT ADEQUATE.
+3 NEW DIR,DIRUT,WVSPEC,WVSPTX,X,Y
+4 if '$GET(WVPCDN)!('$GET(WVRESN))!('$DATA(WVACCN))
QUIT
+5 ;
+6 ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
+7 if $PIECE(^WV(790.31,WVRESN,0),U,21)
QUIT
+8 ;
+9 ;---> FOR PAP WVSPEC=1, FOR ANY TYPE OF MAM WVSPEC=2, OTHERWISE 0.
+10 SET WVSPEC=$SELECT(WVPCDN=1:1,$$PMAM^WVUTL6(WVPCDN):2,1:0)
+11 ;---> QUIT IF NOT A PAP OR MAM.
+12 if 'WVSPEC
QUIT
+13 ;
+14 ;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
+15 ;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
+16 if '$DATA(^WV(790.02,DUZ(2),0))
QUIT
+17 if WVSPEC=1&('$PIECE(^WV(790.02,DUZ(2),0),U,3))
QUIT
+18 if WVSPEC=2&('$PIECE(^WV(790.02,DUZ(2),0),U,7))
QUIT
+19 ;
+20 ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
+21 ;D Q
IF $DATA(^WV(790.4,"C",WVACCN))
QUIT
+22 ;.W !!
+23 ;.W ?5,"* (One or more Notifications already exist for this Procedure.)"
+24 ;
+25 ;---> SET TEXT.
+26 SET WVSPTX=$SELECT(WVSPEC=1:"PAP",WVSPEC=2:"MAM",1:"?")
+27 WRITE !!!
+28 SET DIR("A")="QUEUE a "_WVSPTX_" Result Normal letter to be sent to this patient"
+29 SET DIR(0)="Y"
+30 DO ^DIR
+31 if $DATA(DIRUT)!(Y=0)
QUIT
+32 DO NORMALL^WVNOTIF1(WVDFN,WVACCN,WVSPEC,WVSPTX)
+33 QUIT
+34 ;
