BWUTL4 ;IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES;23-Jan-2009 10:35;DU
;;2.0;WOMEN'S HEALTH;**8,9,11**;MAY 16, 1996
;;* 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.
;
;
NDELQ() ;EP
;---> FOR NOTIFICATIONS:
;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY BW 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(^BWNOT(DA,0)) ""
S X=$P(^BWNOT(DA,0),U,11)
S:'X X=$P(^BWNOT(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 BW 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 BW 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(^BWPCD(DA,0)) ""
Q:'$P(^BWPCD(DA,0),U,12) ""
Q $$PDELQ1(DA,$P(^BWPCD(DA,0),U,12),DUZ2)
;
PDELQ1(BWDA,BWDT,BWDUZ2) ;EP
;---> FOR PROCEDURES:
;---> COMPUTE "COMPLETE BY (BWDT)". CALLED BY UPBWDT/EDIT OF
;---> "BWDT OF PROCEDURE" IN BW PROC-EDITBLK-1.
;---> X1=BWDT OF PROCEDURE, X2=DEFAULT NUMBER OF BWDAYS THE
;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
;---> REQUIRED VARIABLE: BWDA=IEN OF PROCEDURE, BWDT=DATE OF PROCEDURE,
;---> BWDUZ2=DUZ(2).
N %H,X,X1,X2
Q:'$G(BWDA)!('$G(BWDT)) ""
Q:'$D(^BWPCD(BWDA,0)) ""
S X2=$P(^BWPCD(BWDA,0),U,4),X1=BWDT
Q:'X2 ""
Q:'$D(^BWSITE(BWDUZ2,X2)) ""
S X2=$P(^BWSITE(BWDUZ2,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)="n" "NEW"
Q:$P(Y,U,14)="e" "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 BW RESULTS/DIAGNOSIS FILE 9002086.31.
Q:'$G(IEN) "NOT ENTERED"
Q:'$D(^BWDIAG(IEN,0)) "UNKNOWN POINTER"
Q $P(^BWDIAG(IEN,0),U)
;
PRIOR() ;EP
;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE.
Q:'$D(X)!(X']"") 10
Q:'$D(^BWDIAG(X,0)) 10
Q:'$P(^BWDIAG(X,0),U,2) 10
Q $P(^BWDIAG(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 BW RESULTS/DIAGNOSIS FILE.
Q:'$D(X)!(X']"") 2
Q:'$D(^BWDIAG(X,0)) 2
Q:$P(^BWDIAG(X,0),U,21)="" 2
Q $P(^BWDIAG(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 #9002086.1.
N Y
Q:'$G(DA) 0
Q:'$D(^BWPCD(DA,0)) 0
S Y=$P(^BWPCD(DA,0),U,4)
Q:'Y 0
Q:'$D(^BWPN(Y,0)) 0
Q:$P(^BWPN(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^BWUTL5($P(Y,U,12))
I $P(Y,U,5) Q X_"^"_$P(^BWDIAG($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(^BWPCD(DA,0)) ""
Q:'$D(^BWPCD("ACOLP",DA)) ""
S Y=$O(^BWPCD("ACOLP",DA,0)),Y=$O(^BWPCD("ACOLP",DA,Y,0))
Q:'$D(^BWPCD(Y,0)) ""
Q ^BWPCD(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(^BWPCD(DA,0)) 0
S Y=$P(^BWPCD(DA,0),U,4)
Q:'Y 0
Q:'$D(^BWPN(Y,0)) 0
Q:$P(^BWPN(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(9002086.1,.31,0)) "^DD MISSING"
Q $P($P(^DD(9002086.1,.31,0),STAGE_":",2),";")
HPVA(DA) ;
; ---> LOOK FOR ASSOCIATED HPV SCREENING, RETURN ITS ACC# AND DATE
N X,Y
Q:'$G(DA) ""
S Y=$$HPVA0(DA)
Q:Y="" "None"
S X=$P(Y,U)_" on "_$$SLDT2^BWUTL5($P(Y,U,12))
I $P(Y,U,5) Q X_"^"_$P(^BWDIAG($P(Y,U,5),0),U)
Q X_"^"_"Not entered"
HPVA0(DA) ;
;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
N Y
Q:'$G(DA) ""
Q:'$D(^BWPCD(DA,0)) ""
Q:'$D(^BWPCD("AHPV",DA)) ""
S Y=$O(^BWPCD("AHPV",DA,0)),Y=$O(^BWPCD("AHPV",DA,Y,0))
Q:'$D(^BWPCD(Y,0)) ""
Q ^BWPCD(Y,0)
BWUTL4 ;IHS/ANMC/MWR - UTIL: DATE DEFAULTS, OTH VALUES;23-Jan-2009 10:35;DU
+1 ;;2.0;WOMEN'S HEALTH;**8,9,11**;MAY 16, 1996
+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 ;
NDELQ() ;EP
+1 ;---> FOR NOTIFICATIONS:
+2 ;---> COMPUTE DEFAULT "COMPLETE BY (DATE)" - DATE AT WHICH A
+3 ;---> NOTIFICATION BECOMES DELINQUENT. CALLED BY BW 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(^BWNOT(DA,0))
QUIT ""
+14 SET X=$PIECE(^BWNOT(DA,0),U,11)
+15 IF 'X
SET X=$PIECE(^BWNOT(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 BW 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 BW 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(^BWPCD(DA,0))
QUIT ""
+10 IF '$PIECE(^BWPCD(DA,0),U,12)
QUIT ""
+11 QUIT $$PDELQ1(DA,$PIECE(^BWPCD(DA,0),U,12),DUZ2)
+12 ;
PDELQ1(BWDA,BWDT,BWDUZ2) ;EP
+1 ;---> FOR PROCEDURES:
+2 ;---> COMPUTE "COMPLETE BY (BWDT)". CALLED BY UPBWDT/EDIT OF
+3 ;---> "BWDT OF PROCEDURE" IN BW PROC-EDITBLK-1.
+4 ;---> X1=BWDT OF PROCEDURE, X2=DEFAULT NUMBER OF BWDAYS THE
+5 ;---> PROCEDURE IS ALLOWED TO REMAIN OPEN BEFORE BECOMING DELINQUENT.
+6 ;---> REQUIRED VARIABLE: BWDA=IEN OF PROCEDURE, BWDT=DATE OF PROCEDURE,
+7 ;---> BWDUZ2=DUZ(2).
+8 NEW %H,X,X1,X2
+9 IF '$GET(BWDA)!('$GET(BWDT))
QUIT ""
+10 IF '$DATA(^BWPCD(BWDA,0))
QUIT ""
+11 SET X2=$PIECE(^BWPCD(BWDA,0),U,4)
SET X1=BWDT
+12 IF 'X2
QUIT ""
+13 IF '$DATA(^BWSITE(BWDUZ2,X2))
QUIT ""
+14 SET X2=$PIECE(^BWSITE(BWDUZ2,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)="n"
QUIT "NEW"
+7 IF $PIECE(Y,U,14)="e"
QUIT "ERROR"
+8 IF $PIECE(Y,U,13)]""&($PIECE(Y,U,13)<DT)
QUIT "DELINQ"
+9 QUIT "OPEN"
+10 ;
DIAG(IEN) ;EP
+1 ;---> RETURN TEXT OF RESULT/DIAGNOSIS.
+2 ;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE 9002086.31.
+3 IF '$GET(IEN)
QUIT "NOT ENTERED"
+4 IF '$DATA(^BWDIAG(IEN,0))
QUIT "UNKNOWN POINTER"
+5 QUIT $PIECE(^BWDIAG(IEN,0),U)
+6 ;
PRIOR() ;EP
+1 ;---> PROVIDE PRIORITY FOR THIS RESULT/DIAGNOSIS (DEFAULT=10).
+2 ;---> REQUIRED VARIABLE X=IEN IN BW RESULTS/DIAGNOSIS FILE.
+3 IF '$DATA(X)!(X']"")
QUIT 10
+4 IF '$DATA(^BWDIAG(X,0))
QUIT 10
+5 IF '$PIECE(^BWDIAG(X,0),U,2)
QUIT 10
+6 QUIT $PIECE(^BWDIAG(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 BW RESULTS/DIAGNOSIS FILE.
+6 IF '$DATA(X)!(X']"")
QUIT 2
+7 IF '$DATA(^BWDIAG(X,0))
QUIT 2
+8 IF $PIECE(^BWDIAG(X,0),U,21)=""
QUIT 2
+9 QUIT $PIECE(^BWDIAG(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 #9002086.1.
+5 NEW Y
+6 IF '$GET(DA)
QUIT 0
+7 IF '$DATA(^BWPCD(DA,0))
QUIT 0
+8 SET Y=$PIECE(^BWPCD(DA,0),U,4)
+9 IF 'Y
QUIT 0
+10 IF '$DATA(^BWPN(Y,0))
QUIT 0
+11 IF $PIECE(^BWPN(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^BWUTL5($PIECE(Y,U,12))
+7 IF $PIECE(Y,U,5)
QUIT X_"^"_$PIECE(^BWDIAG($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(^BWPCD(DA,0))
QUIT ""
+5 IF '$DATA(^BWPCD("ACOLP",DA))
QUIT ""
+6 SET Y=$ORDER(^BWPCD("ACOLP",DA,0))
SET Y=$ORDER(^BWPCD("ACOLP",DA,Y,0))
+7 IF '$DATA(^BWPCD(Y,0))
QUIT ""
+8 QUIT ^BWPCD(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(^BWPCD(DA,0))
QUIT 0
+6 SET Y=$PIECE(^BWPCD(DA,0),U,4)
+7 IF 'Y
QUIT 0
+8 IF '$DATA(^BWPN(Y,0))
QUIT 0
+9 IF $PIECE(^BWPN(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(9002086.1,.31,0))
QUIT "^DD MISSING"
+4 QUIT $PIECE($PIECE(^DD(9002086.1,.31,0),STAGE_":",2),";")
HPVA(DA) ;
+1 ; ---> LOOK FOR ASSOCIATED HPV SCREENING, RETURN ITS ACC# AND DATE
+2 NEW X,Y
+3 IF '$GET(DA)
QUIT ""
+4 SET Y=$$HPVA0(DA)
+5 IF Y=""
QUIT "None"
+6 SET X=$PIECE(Y,U)_" on "_$$SLDT2^BWUTL5($PIECE(Y,U,12))
+7 IF $PIECE(Y,U,5)
QUIT X_"^"_$PIECE(^BWDIAG($PIECE(Y,U,5),0),U)
+8 QUIT X_"^"_"Not entered"
HPVA0(DA) ;
+1 ;---> IF THERE IS AN ASSOC'D COLP, RETURN ITS ZERO NODE.
+2 NEW Y
+3 IF '$GET(DA)
QUIT ""
+4 IF '$DATA(^BWPCD(DA,0))
QUIT ""
+5 IF '$DATA(^BWPCD("AHPV",DA))
QUIT ""
+6 SET Y=$ORDER(^BWPCD("AHPV",DA,0))
SET Y=$ORDER(^BWPCD("AHPV",DA,Y,0))
+7 IF '$DATA(^BWPCD(Y,0))
QUIT ""
+8 QUIT ^BWPCD(Y,0)
