[613] | 1 | WVMGRP ;HCIOFO/FT,JR IHS/ANMC/MWR - MANAGER'S PATIENT EDITS ;7/29/98 16:44
|
---|
| 2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
| 4 | ;; CALLED BY DIFFERENT OPTIONS TO EDIT A PATIENT'S PAP REGIMEN LOG
|
---|
| 5 | ;; AND PREGNANCY LOG.
|
---|
| 6 | ;
|
---|
| 7 | PLOG ;EP
|
---|
| 8 | ;---> CALLED BY OPTION: "WV EDIT PAP REGIMEN LOG".
|
---|
| 9 | D SETVARS^WVUTL5
|
---|
| 10 | N A,DR,Y
|
---|
| 11 | F D Q:$G(Y)<0
|
---|
| 12 | .D TITLE^WVUTL5("EDIT PAP REGIMEN LOG")
|
---|
| 13 | .D PLOGTX W !
|
---|
| 14 | .S A=" Select PATIENT (or Enter a new BEGIN DATE): "
|
---|
| 15 | .D DIC^WVFMAN(790.04,"QEMAL",.Y,A)
|
---|
| 16 | .Q:Y<0 K WVJR
|
---|
| 17 | .I $P($G(^WV(790.04,+Y,0)),U,2)="" S WVJR=+Y,DIK="^WV(790.04," D DEL Q
|
---|
| 18 | .D NAME("^WV(790.04,",+Y)
|
---|
| 19 | .S DR=".01;.03"
|
---|
| 20 | .D DIE^WVFMAN(790.04,DR,+Y,.WVPOP)
|
---|
| 21 | .S:WVPOP Y=-1
|
---|
| 22 | .Q
|
---|
| 23 | K WVJR
|
---|
| 24 | D EXIT
|
---|
| 25 | Q
|
---|
| 26 | DEL ; Delete File 790.04 or 790.05 entry if no patient
|
---|
| 27 | S DA=WVJR D ^DIK D
|
---|
| 28 | .W !!?10,"**** Patient Name Required --- Entry Deleted ****",!!
|
---|
| 29 | D DIRZ^WVUTL3 Q
|
---|
| 30 | ;
|
---|
| 31 | PLOGTX ;EP
|
---|
| 32 | ;;WARNING: If you edit the "BEGIN DATE:" of an entry in the PAP REGIMEN
|
---|
| 33 | ;; Log, be SURE that another entry with the same "BEGIN DATE:"
|
---|
| 34 | ;; does not already exist for this patient.
|
---|
| 35 | ;;
|
---|
| 36 | ;; (Ordinarily, the program checks this and will not allow
|
---|
| 37 | ;; two separate entries for the same patient on the same
|
---|
| 38 | ;; "BEGIN DATE:". But under this option you, as the Manager,
|
---|
| 39 | ;; have greater edit capability.)
|
---|
| 40 | S WVTAB=5,WVLINL="PLOGTX" D PRINTX
|
---|
| 41 | Q
|
---|
| 42 | ;
|
---|
| 43 | ;
|
---|
| 44 | EDC ;EP
|
---|
| 45 | ;---> CALLED BY OPTION: "WV EDIT PREGNANCY LOG".
|
---|
| 46 | D SETVARS^WVUTL5
|
---|
| 47 | N A,DR,Y
|
---|
| 48 | F D Q:$G(Y)<0
|
---|
| 49 | .D TITLE^WVUTL5("EDIT PREGNANCY LOG")
|
---|
| 50 | .S A=" Select PATIENT (or Enter a new DATE): "
|
---|
| 51 | .D DIC^WVFMAN(790.05,"QEMAL",.Y,A)
|
---|
| 52 | .Q:Y<0 K WVJR
|
---|
| 53 | .I $P($G(^WV(790.05,+Y,0)),U,2)="" S WVJR=+Y,DIK="^WV(790.05," D DEL Q
|
---|
| 54 | .D NAME("^WV(790.05,",+Y)
|
---|
| 55 | .S DR=".01;.03;.04"
|
---|
| 56 | .D DIE^WVFMAN(790.05,DR,+Y,.WVPOP)
|
---|
| 57 | .S:WVPOP Y=-1
|
---|
| 58 | .Q
|
---|
| 59 | K WVJR
|
---|
| 60 | D EXIT
|
---|
| 61 | Q
|
---|
| 62 | ;
|
---|
| 63 | EXIT ;EP
|
---|
| 64 | W @IOF
|
---|
| 65 | D KILLALL^WVUTL8
|
---|
| 66 | Q
|
---|
| 67 | ;
|
---|
| 68 | PRINTX ;EP
|
---|
| 69 | ;---> PRINTS TEXT.
|
---|
| 70 | N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
---|
| 71 | F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
|
---|
| 72 | Q
|
---|
| 73 | ;
|
---|
| 74 | NAME(DIC,Y) ;EP
|
---|
| 75 | N WVDFN
|
---|
| 76 | S WVDFN=$P(@(DIC_Y_",0)"),U,2)
|
---|
| 77 | W !!?3,$$NAME^WVUTL1(WVDFN)," ",$$SSN^WVUTL1(WVDFN),!
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | ;
|
---|
| 81 | NONE ;EP
|
---|
| 82 | S WVTITLE="* There are no PAP Regimen Log entries for this patient. *"
|
---|
| 83 | D CENTERT^WVUTL5(.WVTITLE)
|
---|
| 84 | W !!!!,WVTITLE,!!
|
---|
| 85 | D DIRZ^WVUTL3
|
---|
| 86 | Q
|
---|