| [613] | 1 | WVUTL4 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES; ;7/16/98 09:44
|
|---|
| 2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
|---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
|---|
| 4 | ;; UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
|
|---|
| 5 | ;; STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | NDELQ() ;EP
|
|---|
| 9 | ;---> FOR NOTIFICATIONS:
|
|---|
| 10 | ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
|
|---|
| 11 | ;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY WV NOTIF-EDITBLK-1.
|
|---|
| 12 | ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
|
|---|
| 13 | ;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
|
|---|
| 14 | ;---> 2: DATE NOTIFICATION OPENED, OR
|
|---|
| 15 | ;---> 3: TODAY'S DATE
|
|---|
| 16 | ;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
|
|---|
| 17 | ;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
|
|---|
| 18 | N X
|
|---|
| 19 | Q:'$D(DA) ""
|
|---|
| 20 | Q:'DA ""
|
|---|
| 21 | Q:'$D(^WV(790.4,DA,0)) ""
|
|---|
| 22 | S X=$P(^WV(790.4,DA,0),U,11)
|
|---|
| 23 | S:'X X=$P(^WV(790.4,DA,0),U,2)
|
|---|
| 24 | S:'X X=DT
|
|---|
| 25 | Q $$NDELQ1
|
|---|
| 26 | ;
|
|---|
| 27 | NDELQ1() ;EP
|
|---|
| 28 | ;---> FOR NOTIFICATIONS:
|
|---|
| 29 | ;---> COMPUTE "COMPLETE BY (DATE)". CALLED BY UPDATE/EDIT OF
|
|---|
| 30 | ;---> "PRINT DATE:" IN WV NOTIF-EDITBLK-1.
|
|---|
| 31 | ;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
|
|---|
| 32 | ;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
|
|---|
| 33 | ;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
|
|---|
| 34 | N %H,X1,X2
|
|---|
| 35 | Q:'$D(X) ""
|
|---|
| 36 | Q:'X ""
|
|---|
| 37 | S X1=X,X2=30
|
|---|
| 38 | D C^%DTC
|
|---|
| 39 | Q X
|
|---|
| 40 | ;
|
|---|
| 41 | PDELQ(DA,DUZ2) ;EP
|
|---|
| 42 | ;---> FOR PROCEDURES:
|
|---|
| 43 | ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
|
|---|
| 44 | ;---> PROCEDURE BECOMES DELINQUENT. CALLED BY WV PROC-EDITBLK-1.
|
|---|
| 45 | ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
|
|---|
| 46 | ;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
|
|---|
| 47 | ;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
|
|---|
| 48 | ;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
|
|---|
| 49 | Q:'$G(DA)!('$G(DUZ2)) ""
|
|---|
| 50 | Q:'$D(^WV(790.1,DA,0)) ""
|
|---|
| 51 | Q:'$P(^WV(790.1,DA,0),U,12) ""
|
|---|
| 52 | Q $$PDELQ1(DA,$P(^WV(790.1,DA,0),U,12),DUZ2)
|
|---|
| 53 | ;
|
|---|
| 54 | PDELQ1(WVDA,WVDT,WVDUZ2) ;EP
|
|---|
| 55 | ;---> FOR PROCEDURES:
|
|---|
| 56 | ;---> COMPUTE "COMPLETE BY (WVDT)". CALLED BY UPWVDT/EDIT OF
|
|---|
| 57 | ;---> "WVDT OF PROCEDURE" IN WV PROC-EDITBLK-1.
|
|---|
| 58 | ;---> X1=WVDT OF PROCEDURE, X2=DEFAULT NUMBER OF WVDAYS THE
|
|---|
| 59 | ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
|
|---|
| 60 | ;---> REQUIRED VARIABLE: WVDA=IEN OF PROCEDURE, WVDT=DATE OF PROCEDURE,
|
|---|
| 61 | ;---> WVDUZ2=DUZ(2).
|
|---|
| 62 | N %H,X,X1,X2
|
|---|
| 63 | Q:'$G(WVDA)!('$G(WVDT)) ""
|
|---|
| 64 | Q:'$D(^WV(790.1,WVDA,0)) ""
|
|---|
| 65 | S X2=$P(^WV(790.1,WVDA,0),U,4),X1=WVDT
|
|---|
| 66 | Q:'X2 ""
|
|---|
| 67 | Q:'$D(^WV(790.02,WVDUZ2,X2)) ""
|
|---|
| 68 | S X2=$P(^WV(790.02,WVDUZ2,X2),U,3)
|
|---|
| 69 | D C^%DTC
|
|---|
| 70 | Q X
|
|---|
| 71 | ;
|
|---|
| 72 | STATUS() ;EP
|
|---|
| 73 | ;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
|
|---|
| 74 | ;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
|
|---|
| 75 | ;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
|
|---|
| 76 | Q:'$D(Y) "UNKNOWN"
|
|---|
| 77 | Q:$P(Y,U,14)="c" "CLOSED"
|
|---|
| 78 | Q:$P(Y,U,13)]""&($P(Y,U,13)<DT) "DELINQ"
|
|---|
| 79 | Q "OPEN"
|
|---|
| 80 | ;
|
|---|
| 81 | DIAG(IEN) ;EP
|
|---|
| 82 | ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
|
|---|
| 83 | ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE 790.31.
|
|---|
| 84 | Q:'$G(IEN) "NOT ENTERED"
|
|---|
| 85 | Q:'$D(^WV(790.31,IEN,0)) "UNKNOWN POINTER"
|
|---|
| 86 | Q $P(^WV(790.31,IEN,0),U)
|
|---|
| 87 | ;
|
|---|
| 88 | PRIOR() ;EP
|
|---|
| 89 | ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
|
|---|
| 90 | ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
|
|---|
| 91 | Q:'$D(X)!(X']"") 10
|
|---|
| 92 | Q:'$D(^WV(790.31,X,0)) 10
|
|---|
| 93 | Q:'$P(^WV(790.31,X,0),U,2) 10
|
|---|
| 94 | Q $P(^WV(790.31,X,0),U,2)
|
|---|
| 95 | ;
|
|---|
| 96 | NORMAL(X) ;EP
|
|---|
| 97 | ;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
|
|---|
| 98 | ;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
|
|---|
| 99 | ;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
|
|---|
| 100 | ;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
|
|---|
| 101 | ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
|
|---|
| 102 | Q:'$D(X)!(X']"") 2
|
|---|
| 103 | Q:'$D(^WV(790.31,X,0)) 2
|
|---|
| 104 | Q:$P(^WV(790.31,X,0),U,21)="" 2
|
|---|
| 105 | Q $P(^WV(790.31,X,0),U,21)
|
|---|
| 106 | ;
|
|---|
| 107 | COLP(DA) ;EP
|
|---|
| 108 | ;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
|
|---|
| 109 | ;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
|
|---|
| 110 | ;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
|
|---|
| 111 | ;---> DA=IEN OF PROCEDURE IN PROC FILE #790.1.
|
|---|
| 112 | N Y
|
|---|
| 113 | Q:'$G(DA) 0
|
|---|
| 114 | Q:'$D(^WV(790.1,DA,0)) 0
|
|---|
| 115 | S Y=$P(^WV(790.1,DA,0),U,4)
|
|---|
| 116 | Q:'Y 0
|
|---|
| 117 | Q:'$D(^WV(790.2,Y,0)) 0
|
|---|
| 118 | Q:$P(^WV(790.2,Y,0),U,3)<1 0
|
|---|
| 119 | Q 1
|
|---|
| 120 | ;
|
|---|
| 121 | COLPA(DA) ;EP
|
|---|
| 122 | ;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
|
|---|
| 123 | N X,Y
|
|---|
| 124 | Q:'$G(DA) ""
|
|---|
| 125 | S Y=$$COLP0(DA)
|
|---|
| 126 | Q:Y="" "None"
|
|---|
| 127 | S X=$P(Y,U)_" on "_$$SLDT2^WVUTL5($P(Y,U,12))
|
|---|
| 128 | I $P(Y,U,5) Q X_"^"_$P(^WV(790.31,$P(Y,U,5),0),U)
|
|---|
| 129 | Q X_"^"_"Not entered"
|
|---|
| 130 | ;
|
|---|
| 131 | COLP0(DA) ;EP
|
|---|
| 132 | ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
|
|---|
| 133 | N Y
|
|---|
| 134 | Q:'$G(DA) ""
|
|---|
| 135 | Q:'$D(^WV(790.1,DA,0)) ""
|
|---|
| 136 | Q:'$D(^WV(790.1,"ACOLP",DA)) ""
|
|---|
| 137 | S Y=$O(^WV(790.1,"ACOLP",DA,0)),Y=$O(^WV(790.1,"ACOLP",DA,Y,0))
|
|---|
| 138 | Q:'$D(^WV(790.1,Y,0)) ""
|
|---|
| 139 | Q ^WV(790.1,Y,0)
|
|---|
| 140 | ;
|
|---|
| 141 | MARGIN(DA) ;EP
|
|---|
| 142 | ;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
|
|---|
| 143 | ;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
|
|---|
| 144 | N Y
|
|---|
| 145 | Q:'$G(DA) 0
|
|---|
| 146 | Q:'$D(^WV(790.1,DA,0)) 0
|
|---|
| 147 | S Y=$P(^WV(790.1,DA,0),U,4)
|
|---|
| 148 | Q:'Y 0
|
|---|
| 149 | Q:'$D(^WV(790.2,Y,0)) 0
|
|---|
| 150 | Q:$P(^WV(790.2,Y,0),U,11)<1 0
|
|---|
| 151 | Q 1
|
|---|
| 152 | ;
|
|---|
| 153 | STAGE(STAGE) ;EP
|
|---|
| 154 | ;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
|
|---|
| 155 | Q:'$G(STAGE) ""
|
|---|
| 156 | Q:'$D(^DD(790.1,.31,0)) "^DD MISSING"
|
|---|
| 157 | Q $P($P(^DD(790.1,.31,0),STAGE_":",2),";")
|
|---|
