| [613] | 1 | WVPROC1 ;HCIOFO/FT,JR IHS/ANMC/MWR - WV ADD/EDIT WV PROCEDURE; ;1/26/01 15:12
|
|---|
| 2 | ;;1.0;WOMEN'S HEALTH;**14**;Sep 30, 1998
|
|---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|---|
| 4 | ;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY WVPROC.
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | EDIT2(DA,WVPOP) ;EP
|
|---|
| 8 | ;---> EDIT A PROCEDURE.
|
|---|
| 9 | ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
|
|---|
| 10 | S WVPOP=0
|
|---|
| 11 | I '$G(DA) D D OUT^WVUTL3 Q
|
|---|
| 12 | .W !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
|
|---|
| 13 | I '$D(^WV(790.1,DA,0)) D D OUT^WVUTL3 Q
|
|---|
| 14 | .W !,"^WV(790.1, NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
|
|---|
| 15 | S WVDFN=$P(^WV(790.1,DA,0),U,2)
|
|---|
| 16 | D SCREEN(DA,.WVPOP)
|
|---|
| 17 | ;---> IF ENTRY WAS LOCKED, WVPOP=1.
|
|---|
| 18 | Q:WVPOP
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | SCREEN(DA,WVPOP) ;EP
|
|---|
| 22 | ;---> EDIT A PROCEDURE WITH SCREENMAN.
|
|---|
| 23 | ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
|
|---|
| 24 | ;---> STORE OLD ZERO NODE VALUES IN WVOLD TO COMPARE FOR EDITS,
|
|---|
| 25 | ;---> STORE OLD 2 NODE VALUES IN WVOLD2.
|
|---|
| 26 | ;
|
|---|
| 27 | N WVOLD,WVOLD2,WVPCDN,DDSFILE,DR,Y
|
|---|
| 28 | S DDSFILE=790.1
|
|---|
| 29 | S WVOLD=^WV(790.1,DA,0) S:$D(^(2)) WVOLD2=^WV(790.1,DA,2)
|
|---|
| 30 | S WVPCDN=$P(WVOLD,U,4)
|
|---|
| 31 | ;
|
|---|
| 32 | ;---> SET DR=TO THE APPROPRIATE FORM.
|
|---|
| 33 | D
|
|---|
| 34 | .;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
|
|---|
| 35 | .I $$COLP^WVUTL4(DA) S DR="[WV PROC-FORM-2-COLP]" Q
|
|---|
| 36 | .;
|
|---|
| 37 | .;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
|
|---|
| 38 | .S DR="[WV PROC-FORM-1]"
|
|---|
| 39 | ;
|
|---|
| 40 | ;---> CALL SCREENMAN.
|
|---|
| 41 | D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
|
|---|
| 42 | Q:WVPOP
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | FOLLOWUP(WVDA) ;EP
|
|---|
| 47 | ;---> PROCEDURE FOLLOW-UP MENU.
|
|---|
| 48 | ;---> REQUIRED VARIABLES: WVDA=IEN IN PROCEDURE FILE.
|
|---|
| 49 | ;---> WVLOOP TELLS WVNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
|
|---|
| 50 | ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
|
|---|
| 51 | Q ;dead code?
|
|---|
| 52 | ;
|
|---|
| 53 | NORMAL ;EP
|
|---|
| 54 | ;---> IF RESULT IS NORMAL, ASK TO QUEUE NORMAL PAP/MAM LETTER.
|
|---|
| 55 | ;---> QUIT IF VARIABLES NOT ADEQUATE.
|
|---|
| 56 | N DIR,DIRUT,WVSPEC,WVSPTX,X,Y
|
|---|
| 57 | Q:'$G(WVPCDN)!('$G(WVRESN))!('$D(WVACCN))
|
|---|
| 58 | ;
|
|---|
| 59 | ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
|
|---|
| 60 | Q:$P(^WV(790.31,WVRESN,0),U,21)
|
|---|
| 61 | ;
|
|---|
| 62 | ;---> FOR PAP WVSPEC=1, FOR ANY TYPE OF MAM WVSPEC=2, OTHERWISE 0.
|
|---|
| 63 | S WVSPEC=$S(WVPCDN=1:1,$$PMAM^WVUTL6(WVPCDN):2,1:0)
|
|---|
| 64 | ;---> QUIT IF NOT A PAP OR MAM.
|
|---|
| 65 | Q:'WVSPEC
|
|---|
| 66 | ;
|
|---|
| 67 | ;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
|
|---|
| 68 | ;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
|
|---|
| 69 | Q:'$D(^WV(790.02,DUZ(2),0))
|
|---|
| 70 | Q:WVSPEC=1&('$P(^WV(790.02,DUZ(2),0),U,3))
|
|---|
| 71 | Q:WVSPEC=2&('$P(^WV(790.02,DUZ(2),0),U,7))
|
|---|
| 72 | ;
|
|---|
| 73 | ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
|
|---|
| 74 | I $D(^WV(790.4,"C",WVACCN)) Q ;D Q
|
|---|
| 75 | ;.W !!
|
|---|
| 76 | ;.W ?5,"* (One or more Notifications already exist for this Procedure.)"
|
|---|
| 77 | ;
|
|---|
| 78 | ;---> SET TEXT.
|
|---|
| 79 | S WVSPTX=$S(WVSPEC=1:"PAP",WVSPEC=2:"MAM",1:"?")
|
|---|
| 80 | W !!!
|
|---|
| 81 | S DIR("A")="QUEUE a "_WVSPTX_" Result Normal letter to be sent to this patient"
|
|---|
| 82 | S DIR(0)="Y"
|
|---|
| 83 | D ^DIR
|
|---|
| 84 | Q:$D(DIRUT)!(Y=0)
|
|---|
| 85 | D NORMALL^WVNOTIF1(WVDFN,WVACCN,WVSPEC,WVSPTX)
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
