source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL6.m@ 846

WVUTL6 ;HCIOFO/FT,JR-UTIL: TEXT VALS, DEF PRINT DATE; ;10/11/99  14:03

 ;;1.0;WOMEN'S HEALTH;**3,7**;Sep 30, 1998

 ;;  Original routine created by IHS/ANMC/MWR

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  UTILITY: TEXT FOR PROVIDER, PROCEDURE, HOSP LOC, INSTIT, & ECC.

 ;;  PROC SPECIAL VALUE (PAP, MAM, COLP).  COMPUTE DEFAULT PRINT DATE.

 ;

 ;

PROV() ;EP

 ;---> RETURN TEXT OF PROVIDER'S NAME.

 ;---> REQUIRED VARIABLE: X=IEN IN NEW PERSON FILE #200.

 N WVNAME

 Q:'$D(X) ""

 Q:'X "UNKNOWN"

 S WVNAME=$$GET1^DIQ(200,X,.01,"E")

 Q $S(WVNAME'="":WVNAME,1:"UNKNOWN POINTER")

 ;

 ;

PCDNAM() ;EP

 ;---> RETURN TEXT OF PROCEDURE TYPE.

 ;---> REQUIRED VARIABLE: X=IEN IN WV PROCEDURE TYPE FILE #790.2.

 Q:'$D(X) ""

 Q:'X "UNKNOWN"

 Q:'$D(^WV(790.2,X,0)) "UNKNOWN POINTER"

 Q $P(^WV(790.2,X,0),U)

 ;

HOSPLC() ;EP

 ;---> RETURN TEXT OF HOSPITAL LOCATION NAME.

 ;---> REQUIRED VARIABLE: X=IEN IN HOSPITAL LOCATION FILE #44.

 Q:'$D(X) ""

 Q:'X "UNKNOWN"

 Q:'$D(^SC(X,0)) "UNKNOWN POINTER"

 Q $P(^SC(X,0),U)

 ;

INSTIT() ;EP

 ;---> RETURN IEN OF INSTITUTION (FACILITY) FILE 4, FOR THIS HOSPITAL

 ;---> LOCATION ENTRY IN HOSPITAL LOCATION FILE 44.

 ;---> ALSO CONCATENATE "`" TO THE FRONT OF IEN FOR USE IN DR STRINGS.

 Q:'$D(X) ""

 Q:X="" ""

 Q:'$D(^SC(X,0)) ""

 Q:$P(^SC(X,0),U,4)']"" ""

 Q "`"_$P(^SC(X,0),U,4)

 ;

INSTTX(FACILITY) ;EP

 ;---> RETURN TEXT OF INSTITUTION (FACILITY) NAME.

 ;---> REQUIRED VARIABLE: X=IEN IN INSTITUTION FILE #4.

 Q:'$G(FACILITY) ""

 N WVDIC4

 S WVDIC4=$$GET1^DIQ(4,FACILITY,.01,"E")

 Q $S(WVDIC4]"":WVDIC4,1:"UNKNOWN POINTER")

 ;

ECCDYS() ;EP

 ;---> RETURN TEXT FROM SET OF CODES FOR ECC DYSPLASIA, FIELD .25,

 ;---> OF PROCEDURE FILE 790.1.

 ;---> REQUIRED VARIABLE: X=CODE FOR TEXT OF ECC DYSPLASIA.

 Q:'$D(X) ""

 Q:X="" ""

 I '$$VFIELD^DILFD(790.1,.25) Q "^DD MISSING"

 Q $$EXTERNAL^DILFD(790.1,.25,"",X)

 ;

PNOCX(IEN) ;EP

 ;---> RETURN 1 IF THIS PROCEDURE IS NOT ANY TYPE OF CERVICAL TX.

 Q:'$G(IEN) 1

 Q:'$D(^WV(790.2,IEN,0)) 1

 Q:$$PMAM(IEN) 1

 Q:IEN=27 1  Q:IEN=29 1  Q:IEN=30 1  Q:IEN=31 1  Q:IEN=32 1

 Q:IEN=33 1  Q:IEN=34 1  Q:IEN=35 1

 Q 0

 ;

 ;

PMAM(IEN) ;EP

 ;---> RETURN 1 IF THIS PROCEDURE IS ANY TYPE OF MAMMOGRAM, RETURN 0

 ;---> IF NOT.

 ;---> REQUIRED VARIABLE: IEN=IEN IN PROCEDURE TYPE FILE #790.2.

 ;---> 25, 26, AND 27 ARE IENS OF MAMS IN ^WV(790.2,.

 Q:'$G(IEN) 0

 Q:IEN=25 1  Q:IEN=26 1  Q:IEN=28 1

 Q 0

 ;

 ;

PRTDATE ;EP

 ;---> CALL BY WV NOTIF-EDITBLK-1 TO COMPUTE AND STUFF DATE NOTIFICATION

 ;---> LETTER WILL BE PRINTED, "Print Date" FIELD.  CALLED FROM

 ;---> "TYPE OF NOTIFICATION" FIELD ORDER, "POST ACTION ON CHANGE".

 ;--->

 ;---> IF THE "TYPE OF NOTIFICATION" IS PRINTABLE (LETTER), AS STORED

 ;---> IN #.02 FIELD OF FILE #790.403, THIS COMPUTES PRINT DATE AND

 ;---> STUFFS A DEFAULT "COMPLETE BY DATE" (FIELD #.13) AS WELL.

 ;---> "PRINT DATE" WILL BE CX/BR NEED DUE DATE - SITE PARAMETER, AS

 ;---> STORED IN #.06 FIELD OF FILE #790.02, OR -30 DAYS IF

 ;---> PARAMETER NOT SET.  (SEE PRTDAT^WVUTL2-ABOVE.)

 ;---> "COMPLETE BY DATE" WILL BE "PRINT DATE"+30. SEE NDELQ1^WVUTL4.

 ;--->

 ;---> IF THE "TYPE OF NOTIFICATION" IS NOT PRINTABLE (PHONE), THIS

 ;---> SETS "PRINT DATE"="" AND RECOMPUTES "COMPLETE BY DATE" BASED ON

 ;---> DATE NOTIFICATION WAS OPENED (FIELD #.02) +30 DAYS.

 ;

 ;---> (NOTE: FOR UNIFORMITY, EXECUTABLE DEFAULT FOR "PRINT DATE"

 ;---> CALLS THIS CODE TO SET ITS STORED VALUE, THEN SETS ITS DEFAULT

 ;---> EQUAL TO ITS STORED VALUE.)

 ;--->

 ;---> REQUIRED VARIABLES: WVDFN=IEN OF PATIENT

 ;--->                     DUZ(2)=SITE

 ;--->                     WVTYPE=IEN TYPE OF NOTIFICATION (LETTER, ETC)

 ;--->                     WVPURP=IEN PURPOSE OF NOTIFICATION

 ;

 N WVTYPE,WVPURP,X,Y

 S WVTYPE=$$GET^DDSVAL(DIE,DA,.03)

 I 'WVTYPE D PUT^DDSVAL(DIE,DA,.11,"") Q

 ;---> IF NOT PRINTABLE, SET PRINT DATE="".

 I '$P(^WV(790.403,WVTYPE,0),U,2) D  Q

 .D PUT^DDSVAL(DIE,DA,.11,"")

 .S X=$$NDELQ^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)

 S WVPURP=$$GET^DDSVAL(DIE,DA,.04)

 ;---> COMPUTE AND STUFF PRINT DATE.

 D PRTDAT(WVDFN,DUZ(2),WVTYPE,WVPURP,.X)

 D PUT^DDSVAL(DIE,DA,.11,X)

 ;---> COMPUTE AND STUFF COMPLETE BY DATE.

 S X=$$NDELQ1^WVUTL4 D PUT^DDSVAL(DIE,DA,.13,X)

 Q

 ;

 ;

PRTDAT(DFN,DUZ2,TYPE,PURP,DATE) ;EP

 ;---> YIELD PATIENT'S LETTER PRINT DATE, BASED ON CX/BR NEED.

 ;---> DUE DATE MINUS SITE PARAMETER (OR 30 DAYS, IF NOT SET).

 ;---> TYPE OF NOTIFICATION MUST BE "PRINTABLE" (#.02 OF #790.403).

 ;---> REQUIRED VARIABLES: DFN=IEN OF PATIENT

 ;--->                     DUZ2=DUZ(2)

 ;--->                     TYPE=IEN TYPE OF NOTIFICATION

 ;--->                     PURP=IEN PURPOSE OF NOTIFICATION

 ;---> RETURNS VARIABLES:  DATE=DEFAULT DATE LETTER SHOULD BE PRINTED

 ;

 N P,Q,X,X1,X2

 S DATE=""

 Q:'TYPE!('PURP)

 ;---> QUIT IF THIS "TYPE OF NOTIFICATION" IS NOT "PRINTABLE" (PIECE 2).

 Q:'$P(^WV(790.403,TYPE,0),U,2)

 S X2=$P($G(^WV(790.02,DUZ2,0)),U,6)

 S X2=$S(X2:-X2,1:-30)

 Q:'$D(^WV(790,DFN,0))

 ;---> IF THIS PURPOSE IS A RESULT LETTER, SET PRINT DATE=TODAY, QUIT.

 Q:'$D(^WV(790.404,PURP,0))

 I $P(^WV(790.404,PURP,0),U,6) S DATE=DT Q

 ;---> IF THIS IS NOT ASSOCIATED WITH BR/CX NEEDS, QUIT WITH DATE="".

 Q:$P(^WV(790.404,PURP,0),U,5)=""

 S:$P(^WV(790.404,PURP,0),U,5)="CX" P=11,Q=12

 S:$P(^WV(790.404,PURP,0),U,5)="BR" P=18,Q=19

 ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED ENTERED.

 Q:'$P(^WV(790,DFN,0),U,P)

 ;---> QUIT IF THIS PATIENT HAS NO BR/CX NEED DUE DATE.

 S X=$P(^WV(790,DFN,0),U,Q) Q:'X

 S:'$E(X,7) $E(X,7)=1

 S X1=X D C^%DTC

 S DATE=X

 Q