WVUTL4 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES; ;07/06/2020
;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
;; STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
;
;
GETMAILG() ;
N RESULT,IEN
S IEN=$$GET^XPAR("ALL","WV MAIL GROUP ISSUE")
I +$G(IEN)=0 Q ""
S RESULT=$$GET1^DIQ(3.8,IEN,.01)
Q RESULT
;
NDELQ() ;EP
;---> FOR NOTIFICATIONS:
;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY WV NOTIF-EDITBLK-1.
;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
;---> 2: DATE NOTIFICATION OPENED, OR
;---> 3: TODAY'S DATE
;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
N X
Q:'$D(DA) ""
Q:'DA ""
Q:'$D(^WV(790.4,DA,0)) ""
S X=$P(^WV(790.4,DA,0),U,11)
S:'X X=$P(^WV(790.4,DA,0),U,2)
S:'X X=DT
Q $$NDELQ1
;
NDELQ1() ;EP
;---> FOR NOTIFICATIONS:
;---> COMPUTE "COMPLETE BY (DATE)". CALLED BY UPDATE/EDIT OF
;---> "PRINT DATE:" IN WV NOTIF-EDITBLK-1.
;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
N %H,X1,X2
Q:'$D(X) ""
Q:'X ""
S X1=X,X2=30
D C^%DTC
Q X
;
PDELQ(DA,DUZ2) ;EP
;---> FOR PROCEDURES:
;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
;---> PROCEDURE BECOMES DELINQUENT. CALLED BY WV PROC-EDITBLK-1.
;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
Q:'$G(DA)!('$G(DUZ2)) ""
Q:'$D(^WV(790.1,DA,0)) ""
Q:'$P(^WV(790.1,DA,0),U,12) ""
Q $$PDELQ1(DA,$P(^WV(790.1,DA,0),U,12),DUZ2)
;
PDELQ1(WVDA,WVDT,WVDUZ2) ;EP
;---> FOR PROCEDURES:
;---> COMPUTE "COMPLETE BY (WVDT)". CALLED BY UPWVDT/EDIT OF
;---> "WVDT OF PROCEDURE" IN WV PROC-EDITBLK-1.
;---> X1=WVDT OF PROCEDURE, X2=DEFAULT NUMBER OF WVDAYS THE
;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
;---> REQUIRED VARIABLE: WVDA=IEN OF PROCEDURE, WVDT=DATE OF PROCEDURE,
;---> WVDUZ2=DUZ(2).
N %H,X,X1,X2
Q:'$G(WVDA)!('$G(WVDT)) ""
Q:'$D(^WV(790.1,WVDA,0)) ""
S X2=$P(^WV(790.1,WVDA,0),U,4),X1=WVDT
Q:'X2 ""
Q:'$D(^WV(790.02,WVDUZ2,X2)) ""
S X2=$P(^WV(790.02,WVDUZ2,X2),U,3)
D C^%DTC
Q X
;
STATUS() ;EP
;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
Q:'$D(Y) "UNKNOWN"
Q:$P(Y,U,14)="c" "CLOSED"
Q:$P(Y,U,14)="e" "ENTER IN ERROR"
Q:$P(Y,U,13)]""&($P(Y,U,13)<DT) "DELINQ"
Q "OPEN"
;
DIAG(IEN) ;EP
;---> RETURN TEXT OF RESULT/DIAGNOSIS.
;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE 790.31.
Q:'$G(IEN) "NOT ENTERED"
Q:'$D(^WV(790.31,IEN,0)) "UNKNOWN POINTER"
Q $P(^WV(790.31,IEN,0),U)
;
PRIOR() ;EP
;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
Q:'$D(X)!(X']"") 10
Q:'$D(^WV(790.31,X,0)) 10
Q:'$P(^WV(790.31,X,0),U,2) 10
Q $P(^WV(790.31,X,0),U,2)
;
NORMAL(X) ;EP
;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
Q:'$D(X)!(X']"") 2
Q:'$D(^WV(790.31,X,0)) 2
Q:$P(^WV(790.31,X,0),U,21)="" 2
Q $P(^WV(790.31,X,0),U,21)
;
COLP(DA) ;EP
;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
;---> DA=IEN OF PROCEDURE IN PROC FILE #790.1.
N Y
Q:'$G(DA) 0
Q:'$D(^WV(790.1,DA,0)) 0
S Y=$P(^WV(790.1,DA,0),U,4)
Q:'Y 0
Q:'$D(^WV(790.2,Y,0)) 0
Q:$P(^WV(790.2,Y,0),U,3)<1 0
Q 1
;
COLPA(DA) ;EP
;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
N X,Y
Q:'$G(DA) ""
S Y=$$COLP0(DA)
Q:Y="" "None"
S X=$P(Y,U)_" on "_$$SLDT2^WVUTL5($P(Y,U,12))
I $P(Y,U,5) Q X_"^"_$P(^WV(790.31,$P(Y,U,5),0),U)
Q X_"^"_"Not entered"
;
COLP0(DA) ;EP
;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
N Y
Q:'$G(DA) ""
Q:'$D(^WV(790.1,DA,0)) ""
Q:'$D(^WV(790.1,"ACOLP",DA)) ""
S Y=$O(^WV(790.1,"ACOLP",DA,0)),Y=$O(^WV(790.1,"ACOLP",DA,Y,0))
Q:'$D(^WV(790.1,Y,0)) ""
Q ^WV(790.1,Y,0)
;
MARGIN(DA) ;EP
;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
N Y
Q:'$G(DA) 0
Q:'$D(^WV(790.1,DA,0)) 0
S Y=$P(^WV(790.1,DA,0),U,4)
Q:'Y 0
Q:'$D(^WV(790.2,Y,0)) 0
Q:$P(^WV(790.2,Y,0),U,11)<1 0
Q 1
;
STAGE(STAGE) ;EP
;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
Q:'$G(STAGE) ""
Q:'$D(^DD(790.1,.31,0)) "^DD MISSING"
Q $P($P(^DD(790.1,.31,0),STAGE_":",2),";")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVUTL4 5429 printed Sep 23, 2025@20:24:31 Page 2
WVUTL4 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES; ;07/06/2020
+1 ;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; UTILITY: DEFAULT "COMPLETE BY" DATES FOR NOTIFS AND PROCEDURES,
+4 ;; STATUS TEXT, DIAG TEXT, NORMAL VALUE, COLP VALUE, MARGIN? VALUE.
+5 ;
+6 ;
GETMAILG() ;
+1 NEW RESULT,IEN
+2 SET IEN=$$GET^XPAR("ALL","WV MAIL GROUP ISSUE")
+3 IF +$GET(IEN)=0
QUIT ""
+4 SET RESULT=$$GET1^DIQ(3.8,IEN,.01)
+5 QUIT RESULT
+6 ;
NDELQ() ;EP
+1 ;---> FOR NOTIFICATIONS:
+2 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
+3 ;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY WV NOTIF-EDITBLK-1.
+4 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
+5 ;---> CODE HERE SETS X=EITHER 1: PRINT DATE (IF PRINTABLE), OR
+6 ;---> 2: DATE NOTIFICATION OPENED, OR
+7 ;---> 3: TODAY'S DATE
+8 ;---> THEN $$NDELQ1() IS CALLED TO ADD 30 DAYS UNTIL DELINQUENT.
+9 ;---> REQUIRED VARIABLE: DA (IEN OF NOTIFICATION).
+10 NEW X
+11 if '$DATA(DA)
QUIT ""
+12 if 'DA
QUIT ""
+13 if '$DATA(^WV(790.4,DA,0))
QUIT ""
+14 SET X=$PIECE(^WV(790.4,DA,0),U,11)
+15 if 'X
SET X=$PIECE(^WV(790.4,DA,0),U,2)
+16 if 'X
SET X=DT
+17 QUIT $$NDELQ1
+18 ;
NDELQ1() ;EP
+1 ;---> FOR NOTIFICATIONS:
+2 ;---> COMPUTE "COMPLETE BY (DATE)". CALLED BY UPDATE/EDIT OF
+3 ;---> "PRINT DATE:" IN WV NOTIF-EDITBLK-1.
+4 ;---> X1=EITHER NEW PRINT DATE, OR DATE NOTIF OPENED, OR TODAY.
+5 ;---> X2=30 DAYS ADDED TILL NOTIFICATION BECOMES DELINQUENT.
+6 ;---> REQUIRED VARIABLE: X=PRINT DATE, OR DATE OPENED, OR TODAY.
+7 NEW %H,X1,X2
+8 if '$DATA(X)
QUIT ""
+9 if 'X
QUIT ""
+10 SET X1=X
SET X2=30
+11 DO C^%DTC
+12 QUIT X
+13 ;
PDELQ(DA,DUZ2) ;EP
+1 ;---> FOR PROCEDURES:
+2 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
+3 ;---> PROCEDURE BECOMES DELINQUENT. CALLED BY WV PROC-EDITBLK-1.
+4 ;---> DEFAULT IS CREATED WHEN SCREEN IS FIRST LOADED.
+5 ;---> CODE HERE FIRST RETRIEVES STORED DATE OF PROCEDURE, THEN CALLS
+6 ;---> $$DELQ1 TO COMPUTE "COMPLETE BY (DATE)".
+7 ;---> REQUIRED VARIABLE: DA (IEN OF PROCEDURE), DUZ2=DUZ(2).
+8 if '$GET(DA)!('$GET(DUZ2))
QUIT ""
+9 if '$DATA(^WV(790.1,DA,0))
QUIT ""
+10 if '$PIECE(^WV(790.1,DA,0),U,12)
QUIT ""
+11 QUIT $$PDELQ1(DA,$PIECE(^WV(790.1,DA,0),U,12),DUZ2)
+12 ;
PDELQ1(WVDA,WVDT,WVDUZ2) ;EP
+1 ;---> FOR PROCEDURES:
+2 ;---> COMPUTE "COMPLETE BY (WVDT)". CALLED BY UPWVDT/EDIT OF
+3 ;---> "WVDT OF PROCEDURE" IN WV PROC-EDITBLK-1.
+4 ;---> X1=WVDT OF PROCEDURE, X2=DEFAULT NUMBER OF WVDAYS THE
+5 ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
+6 ;---> REQUIRED VARIABLE: WVDA=IEN OF PROCEDURE, WVDT=DATE OF PROCEDURE,
+7 ;---> WVDUZ2=DUZ(2).
+8 NEW %H,X,X1,X2
+9 if '$GET(WVDA)!('$GET(WVDT))
QUIT ""
+10 if '$DATA(^WV(790.1,WVDA,0))
QUIT ""
+11 SET X2=$PIECE(^WV(790.1,WVDA,0),U,4)
SET X1=WVDT
+12 if 'X2
QUIT ""
+13 if '$DATA(^WV(790.02,WVDUZ2,X2))
QUIT ""
+14 SET X2=$PIECE(^WV(790.02,WVDUZ2,X2),U,3)
+15 DO C^%DTC
+16 QUIT X
+17 ;
STATUS() ;EP
+1 ;---> PROVIDES STATUS (OPEN, DELINQUENT, OR CLOSED).
+2 ;---> Y MUST EQUAL ZERO NODE OF NOTIFICATION.
+3 ;---> REQUIRED VARIABLE: Y=ZERO NODE OF PROCEDURE, DT=FFDATE
+4 if '$DATA(Y)
QUIT "UNKNOWN"
+5 if $PIECE(Y,U,14)="c"
QUIT "CLOSED"
+6 if $PIECE(Y,U,14)="e"
QUIT "ENTER IN ERROR"
+7 if $PIECE(Y,U,13)]""&($PIECE(Y,U,13)<DT)
QUIT "DELINQ"
+8 QUIT "OPEN"
+9 ;
DIAG(IEN) ;EP
+1 ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
+2 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE 790.31.
+3 if '$GET(IEN)
QUIT "NOT ENTERED"
+4 if '$DATA(^WV(790.31,IEN,0))
QUIT "UNKNOWN POINTER"
+5 QUIT $PIECE(^WV(790.31,IEN,0),U)
+6 ;
PRIOR() ;EP
+1 ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
+2 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
+3 if '$DATA(X)!(X']"")
QUIT 10
+4 if '$DATA(^WV(790.31,X,0))
QUIT 10
+5 if '$PIECE(^WV(790.31,X,0),U,2)
QUIT 10
+6 QUIT $PIECE(^WV(790.31,X,0),U,2)
+7 ;
NORMAL(X) ;EP
+1 ;---> PROVIDE NORMAL/ABNORMAL FOR THIS RESULT/DIAGNOSIS.
+2 ;---> WILL RETURN 0 IF NORMAL, 1 IF ABNORMAL (DEFAULT=1),
+3 ;---> 2 IF NO RESULT (EITHER THE PROCEDURE HAS NO RESULT OR
+4 ;---> THE RESULT/DIAGNOSIS HAS "NO RESULT" FOR FIELD #.21).
+5 ;---> REQUIRED VARIABLE X=IEN IN WV RESULTS/DIAGNOSIS FILE.
+6 if '$DATA(X)!(X']"")
QUIT 2
+7 if '$DATA(^WV(790.31,X,0))
QUIT 2
+8 if $PIECE(^WV(790.31,X,0),U,21)=""
QUIT 2
+9 QUIT $PIECE(^WV(790.31,X,0),U,21)
+10 ;
COLP(DA) ;EP
+1 ;---> DETERMINE WHETHER OR NOT THE CURRENT PROCEDURE REQUIRES
+2 ;---> PAGE 2 OF PROCEDURE EDIT SCREENS FOR COLPOSCOPY RESULTS.
+3 ;---> RETURNS 1 IF COLP-TYPE RESULTS, OTHERWISE 0.
+4 ;---> DA=IEN OF PROCEDURE IN PROC FILE #790.1.
+5 NEW Y
+6 if '$GET(DA)
QUIT 0
+7 if '$DATA(^WV(790.1,DA,0))
QUIT 0
+8 SET Y=$PIECE(^WV(790.1,DA,0),U,4)
+9 if 'Y
QUIT 0
+10 if '$DATA(^WV(790.2,Y,0))
QUIT 0
+11 if $PIECE(^WV(790.2,Y,0),U,3)<1
QUIT 0
+12 QUIT 1
+13 ;
COLPA(DA) ;EP
+1 ;---> LOOK FOR ASSOCIATED COLPOSCOPY, RETURN ITS ACC# AND DATE.
+2 NEW X,Y
+3 if '$GET(DA)
QUIT ""
+4 SET Y=$$COLP0(DA)
+5 if Y=""
QUIT "None"
+6 SET X=$PIECE(Y,U)_" on "_$$SLDT2^WVUTL5($PIECE(Y,U,12))
+7 IF $PIECE(Y,U,5)
QUIT X_"^"_$PIECE(^WV(790.31,$PIECE(Y,U,5),0),U)
+8 QUIT X_"^"_"Not entered"
+9 ;
COLP0(DA) ;EP
+1 ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
+2 NEW Y
+3 if '$GET(DA)
QUIT ""
+4 if '$DATA(^WV(790.1,DA,0))
QUIT ""
+5 if '$DATA(^WV(790.1,"ACOLP",DA))
QUIT ""
+6 SET Y=$ORDER(^WV(790.1,"ACOLP",DA,0))
SET Y=$ORDER(^WV(790.1,"ACOLP",DA,Y,0))
+7 if '$DATA(^WV(790.1,Y,0))
QUIT ""
+8 QUIT ^WV(790.1,Y,0)
+9 ;
MARGIN(DA) ;EP
+1 ;---> DETERMINE WHETHER THE "MARGINS CLEAR?" QUESTION (PAGE 2 OF
+2 ;---> PROCEDURE EDIT) SHOULD BE ASKED FOR THIS PROCEDURE.
+3 NEW Y
+4 if '$GET(DA)
QUIT 0
+5 if '$DATA(^WV(790.1,DA,0))
QUIT 0
+6 SET Y=$PIECE(^WV(790.1,DA,0),U,4)
+7 if 'Y
QUIT 0
+8 if '$DATA(^WV(790.2,Y,0))
QUIT 0
+9 if $PIECE(^WV(790.2,Y,0),U,11)<1
QUIT 0
+10 QUIT 1
+11 ;
STAGE(STAGE) ;EP
+1 ;---> RETURN THE TEXT OF THE STAGE OF CARCINOMA.
+2 if '$GET(STAGE)
QUIT ""
+3 if '$DATA(^DD(790.1,.31,0))
QUIT "^DD MISSING"
+4 QUIT $PIECE($PIECE(^DD(790.1,.31,0),STAGE_":",2),";")
