- 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 Jan 18, 2025@03:48:33 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 ;