- 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 Feb 19, 2025@00:14:40 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),";")
