WVRPCGF1.m

WVRPCGF1 ;ISP/AGP - APIs for Clinical Reminders ;Oct 24, 2023@15:22:45

 ;;1.0;WOMEN'S HEALTH;**24,26,32**;Sep 30, 1998;Build 7

 ;

 ;

ACOPY(REF,OUTPUT) ;Copy all the descendants of the array reference into a linear

 ;array. REF is the starting array reference, for example A or

 ;^TMP("PXRM",$J). OUTPUT is the linear array for the output. It

 ;should be in the form of a closed root, i.e., A() or ^TMP($J,).

 ;Note OUTPUT cannot be used as the name of the output array.

 N DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP

 I REF="" Q

 S NL=0

 S OROOT=$P(OUTPUT,")",1)

 S PROOT=$P(REF,")",1)

 ;Build the root so we can tell when we are done.

 S TEMP=$NA(@REF)

 S ROOT=$P(TEMP,")",1)

 S REF=$Q(@REF)

 I REF'[ROOT Q

 S DONE=0

 F  Q:(REF="")!(DONE)  D

 . S START=$F(REF,ROOT)

 . S LEN=$L(REF)

 . S IND=$E(REF,START,LEN)

 . S NL=NL+1

 . S OUT=OROOT_NL_")"

 . S @OUT=PROOT_IND_"="_@REF

 . S REF=$Q(@REF)

 . I REF'[ROOT S DONE=1

 Q

 ;

 ;build error message array

BLDMSG(PAT,SUBJ,NUM) ;

 N CNT,ERR,GROUP,XMDUZ,XMSUB,XMTEXT,Y

 K ^TMP("WV MSG",$J),XMY

 S GROUP=$$GETMAILG^WVUTL4()

 S CNT=0,XMDUZ=DUZ,XMSUB=SUBJ,XMTEXT="^TMP(""WV MSG"",$J,",XMY(DUZ)="",XMY("G."_GROUP)=""

 S NUM=NUM+1,^TMP("WV MSG",$J,NUM,0)="Patient DFN: "_PAT

 S NUM=NUM+1,^TMP("WV MSG",$J,NUM,0)="ERROR:"

 D ACOPY("WVERR","ERR()")

 S CNT=0 F  S CNT=$O(ERR(CNT)) Q:CNT'>0  S NUM=NUM+1,^TMP("WV MSG",$J,NUM,0)=ERR(CNT)

 S NUM=NUM+1,^TMP("WV MSG",$J,NUM,0)=""

 S NUM=NUM+1,^TMP("WV MSG",$J,NUM,0)="INPUTS:"

 K ERR

 D ACOPY("INPUTS","ERR()")

 D ^XMD

 Q

 ;

MKWSDEV ;Make the WV WORKSTATION device.

 N FDA,FDAIEN,MSG

 ;Make sure that the device does not get created more than once.

 I +$$FIND1^DIC(3.5,"","MX","WV WORKSTATION")>0 Q

 S FDA(3.5,"+1,",.01)="WV WORKSTATION" ;NAME

 S FDA(3.5,"+1,",.02)="WV Workstation HFS Device" ;LOCATION OF TERMINAL

 S FDA(3.5,"+1,",1)="WVWSD.DAT" ;$I

 S FDA(3.5,"+1,",1.95)=0 ;SIGN-ON/SYSTEM DEVICE

 S FDA(3.5,"+1,",2)="HFS" ;TYPE

 S FDA(3.5,"+1,",3)=$$FIND1^DIC(3.2,"","MX","P-OTHER") ;SUBTYPE

 S FDA(3.5,"+1,",4)=0 ;ASK DEVICE

 S FDA(3.5,"+1,",5)=0 ;ASK PARAMETERS

 S FDA(3.5,"+1,",5.1)=0 ;ASK HOST FILE

 S FDA(3.5,"+1,",5.2)=0 ;ASK HFS I/O OPERATION

 D UPDATE^DIE("","FDA","FDAIEN","MSG")

 Q

 ;

 ;print api for CPRS view/print RPC

PRINT(RESULT,WVDFN,WVPURPTX) ;

 N BY,DIWF

 N %ZIS,BY,DC,DHD,DONE,FF,FILENAME,FILESPEC,FLDS,FR,GBL,HFNAME

 N IND,IOP,NOW,PATH,VAR,WVPURP,SUCCESS,TO,UNIQN

 S WVPURP=$O(^WV(790.404,"B",WVPURPTX,"")) I WVPURP'>0 Q

 ;D MKWSDEV^PXRMHOST

 D MKWSDEV

 ;Set up the output file before DIP is called.

 S PATH=$$PWD^%ZISH

 S NOW=$$NOW^XLFDT

 S NOW=$TR(NOW,".","")

 S UNIQN=$J_NOW

 S FILENAME="WVLETTER"_UNIQN_".DAT"

 S HFNAME=PATH_FILENAME

 S IOP="WV WORKSTATION;80"

 S %ZIS("HFSMODE")="W"

 S %ZIS("HFSNAME")=HFNAME

 S DIWF="^WV(790.404,WVPURP,1,"

 S DIWF(1)=790

 S BY="INTERNAL(#.01)="_WVDFN

 D GADD^WVUTL9(WVDFN) ;get current complete address

 D SADD^WVUTL9(WVDFN) ;set complete address in File 790

 D KVAR^WVUTL9 ;clean-up VADPT variables used

 D EN2^DIWF

 S GBL="^TMP(""WVLETTER"",$J,1,0)"

 S GBL=$NA(@GBL)

 K ^TMP("WVLETTER",$J)

 S SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)

 ;Look for a form feed, remove it and all subsequent lines.

 S FF=$C(12)

 I $G(VAR)["^" D

 . S VAR=$NA(@VAR)

 . S VAR=$P(VAR,")",1)

 . S VAR=VAR_",IND,0)"

 . S (DONE,IND)=0

 . F  Q:DONE  S IND=$O(^TMP("WVLETTER",$J,IND)) Q:+IND=0  D

 .. I ^TMP("WVLETTER",$J,IND,0)=FF S DONE=1 Q

 .. S @VAR=^TMP("WVLETTER",$J,IND,0)

 E  D

 . S (DONE,IND)=0

 . F  Q:DONE  S IND=$O(^TMP("WVLETTER",$J,IND)) Q:+IND=0  D

 .. S VAR(IND)=^TMP("WVLETTER",$J,IND,0)

 .. I VAR(IND)=FF S DONE=1

 S IND=0 F  S IND=$O(^TMP("WVLETTER",$J,IND)) Q:IND'>0  D

 .S RESULT(IND)=$G(^TMP("WVLETTER",$J,IND,0))

 S RESULT(0)=1_U_WVPURPTX_" letter"

 K ^TMP("WVLETTER",$J)

 ;Delete the host file.

 S FILESPEC(FILENAME)=""

 S SUCCESS=$$DEL^%ZISH(PATH,$NA(FILESPEC))

 Q

 ;

NEXTPROC(DFN,TYPE) ;

 N NAME,NODE

 I TYPE="BR" S NODE=$P($G(^WV(790,DFN,0)),U,18,19)

 I TYPE="CX" S NODE=$P($G(^WV(790,DFN,0)),U,11,12)

 I +$P(NODE,U)'>0 Q ""

 I +$P(NODE,U,2)'>0 Q ""

 I TYPE="BR" S NAME=$P($G(^WV(790.51,$P(NODE,U),0)),U)

 I TYPE="CX" S NAME=$P($G(^WV(790.5,$P(NODE,U),0)),U)

 I NAME="" Q ""

 Q NAME_U_$P(NODE,U,2)

 ;

VIEWDATA(RESULT,DATA,PAT,FINDVAL) ;

 ;FINDINGS("WOMEN'S HEALTH",FILE,CNT)=SUBSCRIPT_U_VALUE_U_PROMPT TYPE IEN_U_PROMPT SUBSCRIPT

 N CNT,PKG,FILE,NODE,SUB,VALUE

 S PKG="WOMEN'S HEALTH"

 I '$D(DATA(PKG,790.4)),'$D(DATA(PKG,790.1)) Q

 I $D(DATA(PKG,790.4)) D V7904(.RESULT,.DATA,PAT,FINDVAL)

 I $D(DATA(PKG,790.1)) D V7901(.RESULT,.DATA,PAT,FINDVAL)

 Q

 ;

V7904(RESULT,DATA,PAT,FINDVAL) ;

 N INC,NODE,PKG,SUB,SUB1,VALUE

 S PKG="WOMEN'S HEALTH"

 S INC=0 F  S INC=$O(DATA(PKG,790.4,INC)) Q:INC'>0  D

 .S NODE=$G(DATA(PKG,790.4,INC))

 .S SUB=$P(NODE,U),VALUE=$P(NODE,U,2),SUB1=$P(NODE,U,4)

 .I SUB=".04" D PRINT^WVRPCGF1(.RESULT,PAT,VALUE) Q

 .;I SUB="No Notifications" D

 .;.S RESULT(0)=0_U_"Procedure(s) with no documented notification"

 .;.D FNDWDATA^PXRMRPCG(.RESULT,PAT,IEN,FINDVAL,VALUE)

 Q

 ;

V7901(RESULT,DATA,PAT,FINDVAL) ;

 N CNT,DIR,DIAG,I,INC,NODE,PKG,SUB,SUB1,TCNT,TEXT,VALUE,X

 S PKG="WOMEN'S HEALTH"

 S INC=0 F  S INC=$O(DATA(PKG,790.1,INC)) Q:INC'>0  D

 .S NODE=$G(DATA(PKG,790.1,INC))

 .S SUB=$P(NODE,U),VALUE=$P(NODE,U,2),SUB1=$P(NODE,U,4)

 .I SUB="LAST THREE TRMTS" D  Q

 ..K ^TMP("PXRMRPCG REPORT",$J)

 ..S DIR=1

 ..I $$LAST3^WVHS("PXRMRPCG REPORT",PAT,3,DIR)="" Q

 ..S RESULT(0)=1_U_"Last Three Breast Imaging Reports "_$S(DIR=1:"(Most Recent to Oldest)",1:"(Oldest to Most Recent)")

 ..S CNT=0,I=0 F  S I=$O(^TMP("PXRMRPCG REPORT",$J,I)) Q:I'>0  D

 ...S CNT=CNT+1,RESULT(CNT)=$G(^TMP("PXRMRPCG REPORT",$J,I,0))

 .I SUB=.01 D  Q

 ..S CNT=0

 ..;S RESULT(0)=1_U

 ..S RESULT(0)=1_U_"Open Breast Imaging (Oldest to Most Recent)"

 ..F X=1:1:$L(FINDVAL,":") D

 ...K TEXT

 ...;S TCNT=0

 ...D GETTEST(+$P(FINDVAL,":",X),.TEXT,.DIAG)

 ...I X>1 S CNT=CNT+1,RESULT(CNT)="",CNT=CNT+1,RESULT(CNT)="----------------------------------------------------------",CNT=CNT+1,RESULT(CNT)=""

 ...S TCNT=0 F  S TCNT=$O(TEXT(TCNT)) Q:TCNT'>0  S CNT=CNT+1,RESULT(CNT)=TEXT(TCNT)

 ...S CNT=CNT+1,RESULT(CNT)=""

 Q

 ;

GETWVP(DFN,ITEM,TEXT) ;

 N ACCESS,CNT,DTE,DATE,DIAGNS,ERROR,FUDATE,ID,NODE,PREVDT,PREVIEN,PREVDX,SECDX,TCNT,TEMP

 N WVIENS,WVNTXT,WVRPTIEN,WVSECDXS,X

 S NODE=$G(^WV(790.1,+ITEM,0))

 D RADCASE^WVALERTR(+ITEM,.DIAGNS,.WVIENS,.WVRPTIEN,.WVSECDXS)

 S TCNT=0,DTE=0

 S ACCESS=$P(NODE,U),TCNT=TCNT+1,TEXT(TCNT)="Accession #: "_ACCESS

 S TEMP=$P(NODE,U,4) I TEMP'="" D

 .S TCNT=TCNT+1,TEXT(TCNT)="Procedure: "_$P($G(^WV(790.2,TEMP,0)),U)

 S TEMP=$P(NODE,U,12) I TEMP'="" D

 .S DTE=TEMP

 .S TCNT=TCNT+1,TEXT(TCNT)="Date of Procedure: "_$$FMTE^XLFDT(TEMP)

 I $P(NODE,U,14)="e" D  Q

 .S TCNT=TCNT+1,TEXT(TCNT)="Outside Procedure marked ENTER IN ERROR"

 S TCNT=TCNT+1,TEXT(TCNT)=""

 S TEMP=$P(NODE,U,5) I TEMP'="" D

 .S TEMP=$$RETBIRAD($P($G(^WV(790.31,TEMP,0)),U),DTE)

 .S TCNT=TCNT+1,TEXT(TCNT)="Primary Result: "_TEMP

 I $D(WVSECDXS)>1 D

 .S SECDX="" F  S SECDX=$O(WVSECDXS(SECDX)) Q:SECDX=""  D

 ..S TCNT=TCNT+1,TEXT(TCNT)="Secondary Result(s): "_SECDX

 ;AGP TODO BEGIN display previous diagnosis if set

 I $D(^WV(790.1,+ITEM,11,"D")) D

 .S TCNT=TCNT+1,TEXT(TCNT)="Radiology report changed; prior report result was:"

 .S PREVDT=""

 .F  S PREVDT=$O(^WV(790.1,+ITEM,11,"D",PREVDT)) Q:PREVDT=""  D

 ..S PREVIEN=0

 ..F  S PREVIEN=$O(^WV(790.1,+ITEM,11,"D",PREVDT,PREVIEN)) Q:PREVIEN=""  D

 ...S PREVDX=+$P($G(^WV(790.1,+ITEM,11,PREVIEN,0)),U) I PREVDX=0 Q

 ...S TEMP=$P($G(^WV(790.31,PREVDX,0)),U)

 ...S TCNT=TCNT+1,TEXT(TCNT)=TEMP_"  changed on "_$$FMTE^XLFDT(PREVDT)

 ;AGP TODO END

 S TCNT=TCNT+1,TEXT(TCNT)=""

 I +$P(NODE,U,36)=1 S TCNT=TCNT+1,TEXT(TCNT)="Outside Report: True"

 I +$P(NODE,U,36)'=1 D

 .S TCNT=TCNT+1,TEXT(TCNT)="Radiology Case#: "_$P(NODE,U,15)

 .S TCNT=TCNT+1,TEXT(TCNT)="Provider: "_$S($P(NODE,U,7)>0:$$GET1^DIQ(200,$P(NODE,U,7),.01),1:"None define")

 I $G(^WV(790.1,+ITEM,3))'="" S TCNT=TCNT+1,TEXT(TCNT)="Procedure Comments: "_$G(^WV(790.1,+ITEM,3))

 ;

 I $D(^WV(790.1,+ITEM,10,"DATE")) D

 .S TCNT=TCNT+1,TEXT(TCNT)=""

 .S DATE=0 F  S DATE=$O(^WV(790.1,+ITEM,10,"DATE",DATE)) Q:DATE'>0  D

 ..S TCNT=TCNT+1,TEXT(TCNT)="Review of recommendations done on "_$$FMTE^XLFDT(DATE)

 ..S TEMP="" F  S TEMP=$O(^WV(790.1,+ITEM,10,"DATE",DATE,TEMP)) Q:TEMP=""  D

 ...S TCNT=TCNT+1,TEXT(TCNT)=TEMP

 ...S ID=$O(^WV(790.1,+ITEM,10,"DATE",DATE,TEMP,"")) Q:ID=""

 ...S ERROR=$S($P($G(^WV(790.1,+ITEM,10,ID,0)),U,5)="Y":1,1:0)

 ...S FUDATE=+$P($G(^WV(790.1,+ITEM,10,ID,0)),U,6)

 ...I FUDATE>0 S TEXT(TCNT)=TEXT(TCNT)_" by "_$$FMTE^XLFDT(FUDATE)

 ...I ERROR S TEXT(TCNT)=TEXT(TCNT)_" marked ENTER IN ERROR"

 ...I 'ERROR,$G(^WV(790.1,+ITEM,10,ID,1))'="" S TCNT=TCNT+1,TEXT(TCNT)="Comment: "_$G(^WV(790.1,+ITEM,10,ID,1))

 ;

 D GETWVN(DFN,ACCESS,.WVNTXT)

 S TCNT=TCNT+1,TEXT(TCNT)=""

 S CNT=0 F  S CNT=$O(WVNTXT(CNT)) Q:CNT'>0  S TCNT=TCNT+1,TEXT(TCNT)=WVNTXT(CNT)

 Q

 ;

GETWVN(DFN,ITEM,TEXT) ;

 N DATE,IEN,ERROR,FIRST,METHOD,NAME,NODE,PURIEN,PUR,TCNT,TEMP,WHO

 S TCNT=0,FIRST=1

 S TCNT=TCNT+1,TEXT(TCNT)="Prior Patient communication details:"

 S IEN=0 F  S IEN=$O(^WV(790.4,"C",ITEM,IEN)) Q:IEN'>0  D

 .S NODE=$G(^WV(790.4,IEN,0))

 .I $P(NODE,U,14)="e" Q

 .S PURIEN=$P(NODE,U,4) Q:PURIEN'>0

 .S PUR=$P($G(^WV(790.404,PURIEN,0)),U)

 .S TEMP=$P(NODE,U,3) I TEMP="" Q

 .I TEMP'="" S NAME=$P($G(^WV(790.403,TEMP,0)),U)

 .S DATE=+$P(NODE,U,8)

 .I $P($G(^WV(790.4,IEN,1)),U)'="" D  Q

 ..;I +DATE>0 S METHOD(NAME)=U_$$FMTE^XLFDT(DATE) Q

 ..;S NODE=$G(^WV(790.4,IEN,1)) I NODE'=U S TCNT=TCNT+1,TEXT(TCNT)="Communication detail: Spoke to "_$P(NODE,U)_" on "_$$FMTE^XLFDT($P(NODE,U,2))

 ..;S NODE=$G(^WV(790.4,IEN,1)) I NODE'=U S TCNT=TCNT+1,TEXT(TCNT)="Spoke to "_$P(NODE,U)_" on "_$$FMTE^XLFDT($P(NODE,U,2)) Q

 ..S NODE=$G(^WV(790.4,IEN,1)) I NODE'=U S METHOD("Spoke to "_$P(NODE,U)_" on "_$$FMTE^XLFDT($P(NODE,U,2)))="" Q

 ..;S TCNT=TCNT+1,TEXT(TCNT)=NAME_$S(DATE>0:" "_$$FMTE^XLFDT(DATE),1:"")

 ..S METHOD(NAME_$S(DATE>0:" "_$$FMTE^XLFDT(DATE),1:""))=""

 .;S TCNT=TCNT+1,TEXT(TCNT)=NAME_$S(DATE>0:" "_$$FMTE^XLFDT(DATE),1:"")

 .S METHOD(NAME_$S(DATE>0:" "_$$FMTE^XLFDT(DATE),1:""))=""

 S TEMP="" F  S TEMP=$O(METHOD(TEMP)) Q:TEMP=""  D

 .S TCNT=TCNT+1,TEXT(TCNT)=TEMP

 I TCNT=1 S TCNT=TCNT+1,TEXT(TCNT)="None on file"

 Q

 ;

BRNEEDS(RESULT,BDT,EDT,TEST) ;

 N DATE,END,PAT,PROC

 S PROC=$O(^WV(790.51,"B",TEST,"")) Q:PROC'>0

 S DATE=$S(BDT>0:BDT,1:0)

 S END=$S(EDT>0:EDT,1:DT)

 F  S DATE=$O(^WV(790,"BRNEEDS",PROC,DATE)) Q:DATE'>0!(DATE'<END)  D

 .S PAT="" F  S PAT=$O(^WV(790,"BRNEEDS",PROC,DATE,PAT)) Q:PAT'>0  S RESULT(PAT)=DATE

 Q

 ;

GETTEST(WVIEN,TEXT,DIAG) ;

 N Y

 K ^TMP("WV RPT",$J)

 D EN^WVALERTR(+WVIEN,.DIAG)

 I '$D(^TMP("WV RPT",$J)) S TEXT(1)="No Imaging found in Radiology Package" Q

 S Y=0 F  S Y=$O(^TMP("WV RPT",$J,Y)) Q:Y'>0  S INC=INC+1,TEXT(INC)=$G(^TMP("WV RPT",$J,Y,0))

 K ^TMP("WV RPT",$J)

 Q

 ;

SETOPEN(DA,VALUES) ;

 I +VALUES(1)'>0 Q 0

 I VALUES(2)="" Q 0

 I VALUES(3)="" Q 0

 I VALUES(4)'="o" Q 0

 Q 1

 ;

KILLOPEN(DA,VALUES) ;

 I +VALUES(1)'>0 Q 1

 I VALUES(2)="" Q 1

 I VALUES(3)="" Q 1

 I VALUES(4)'="o" Q 1

 Q 0

 ;

RETBIRAD(CODE,PDTE) ;

 N DTE,WVDATES

 I PDTE=0 Q CODE

 ;I '$$INSTALDT^XPDUTL("WV*1.0*32",.WVDATES) Q CODE

 I '$$INSTALDT^XPDUTL("RA*5.0*206",.WVDATES) Q CODE

 I CODE'="BI-RADS CATEGORY 0 Need Additional Imaging Evaluation" Q CODE

 S DTE=+$O(WVDATES("A"),-1) I DTE=0 Q CODE

 I PDTE<DTE S CODE="BI-RADS CATEGORY 0"

 Q CODE

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---WVRPCGF1   11605     printed  Feb 19, 2025@00:14:05                                                                                                                                                                                                   Page 2

WVRPCGF1  ;ISP/AGP - APIs for Clinical Reminders ;Oct 24, 2023@15:22:45

 +1       ;;1.0;WOMEN'S HEALTH;**24,26,32**;Sep 30, 1998;Build 7

 +2       ;

 +3       ;

ACOPY(REF,OUTPUT) ;Copy all the descendants of the array reference into a linear

 +1       ;array. REF is the starting array reference, for example A or

 +2       ;^TMP("PXRM",$J). OUTPUT is the linear array for the output. It

 +3       ;should be in the form of a closed root, i.e., A() or ^TMP($J,).

 +4       ;Note OUTPUT cannot be used as the name of the output array.

 +5        NEW DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP

 +6        IF REF=""

               QUIT 

 +7        SET NL=0

 +8        SET OROOT=$PIECE(OUTPUT,")",1)

 +9        SET PROOT=$PIECE(REF,")",1)

 +10      ;Build the root so we can tell when we are done.

 +11       SET TEMP=$NAME(@REF)

 +12       SET ROOT=$PIECE(TEMP,")",1)

 +13       SET REF=$QUERY(@REF)

 +14       IF REF'[ROOT

               QUIT 

 +15       SET DONE=0

 +16       FOR 

               if (REF="")!(DONE)

                   QUIT 

               Begin DoDot:1

 +17               SET START=$FIND(REF,ROOT)

 +18               SET LEN=$LENGTH(REF)

 +19               SET IND=$EXTRACT(REF,START,LEN)

 +20               SET NL=NL+1

 +21               SET OUT=OROOT_NL_")"

 +22               SET @OUT=PROOT_IND_"="_@REF

 +23               SET REF=$QUERY(@REF)

 +24               IF REF'[ROOT

                       SET DONE=1

               End DoDot:1

 +25       QUIT 

 +26      ;

 +27      ;build error message array

BLDMSG(PAT,SUBJ,NUM) ;

 +1        NEW CNT,ERR,GROUP,XMDUZ,XMSUB,XMTEXT,Y

 +2        KILL ^TMP("WV MSG",$JOB),XMY

 +3        SET GROUP=$$GETMAILG^WVUTL4()

 +4        SET CNT=0

           SET XMDUZ=DUZ

           SET XMSUB=SUBJ

           SET XMTEXT="^TMP(""WV MSG"",$J,"

           SET XMY(DUZ)=""

           SET XMY("G."_GROUP)=""

 +5        SET NUM=NUM+1

           SET ^TMP("WV MSG",$JOB,NUM,0)="Patient DFN: "_PAT

 +6        SET NUM=NUM+1

           SET ^TMP("WV MSG",$JOB,NUM,0)="ERROR:"

 +7        DO ACOPY("WVERR","ERR()")

 +8        SET CNT=0

           FOR 

               SET CNT=$ORDER(ERR(CNT))

               if CNT'>0

                   QUIT 

               SET NUM=NUM+1

               SET ^TMP("WV MSG",$JOB,NUM,0)=ERR(CNT)

 +9        SET NUM=NUM+1

           SET ^TMP("WV MSG",$JOB,NUM,0)=""

 +10       SET NUM=NUM+1

           SET ^TMP("WV MSG",$JOB,NUM,0)="INPUTS:"

 +11       KILL ERR

 +12       DO ACOPY("INPUTS","ERR()")

 +13       DO ^XMD

 +14       QUIT 

 +15      ;

MKWSDEV   ;Make the WV WORKSTATION device.

 +1        NEW FDA,FDAIEN,MSG

 +2       ;Make sure that the device does not get created more than once.

 +3        IF +$$FIND1^DIC(3.5,"","MX","WV WORKSTATION")>0

               QUIT 

 +4       ;NAME

           SET FDA(3.5,"+1,",.01)="WV WORKSTATION"

 +5       ;LOCATION OF TERMINAL

           SET FDA(3.5,"+1,",.02)="WV Workstation HFS Device"

 +6       ;$I

           SET FDA(3.5,"+1,",1)="WVWSD.DAT"

 +7       ;SIGN-ON/SYSTEM DEVICE

           SET FDA(3.5,"+1,",1.95)=0

 +8       ;TYPE

           SET FDA(3.5,"+1,",2)="HFS"

 +9       ;SUBTYPE

           SET FDA(3.5,"+1,",3)=$$FIND1^DIC(3.2,"","MX","P-OTHER")

 +10      ;ASK DEVICE

           SET FDA(3.5,"+1,",4)=0

 +11      ;ASK PARAMETERS

           SET FDA(3.5,"+1,",5)=0

 +12      ;ASK HOST FILE

           SET FDA(3.5,"+1,",5.1)=0

 +13      ;ASK HFS I/O OPERATION

           SET FDA(3.5,"+1,",5.2)=0

 +14       DO UPDATE^DIE("","FDA","FDAIEN","MSG")

 +15       QUIT 

 +16      ;

 +17      ;print api for CPRS view/print RPC

PRINT(RESULT,WVDFN,WVPURPTX) ;

 +1        NEW BY,DIWF

 +2        NEW %ZIS,BY,DC,DHD,DONE,FF,FILENAME,FILESPEC,FLDS,FR,GBL,HFNAME

 +3        NEW IND,IOP,NOW,PATH,VAR,WVPURP,SUCCESS,TO,UNIQN

 +4        SET WVPURP=$ORDER(^WV(790.404,"B",WVPURPTX,""))

           IF WVPURP'>0

               QUIT 

 +5       ;D MKWSDEV^PXRMHOST

 +6        DO MKWSDEV

 +7       ;Set up the output file before DIP is called.

 +8        SET PATH=$$PWD^%ZISH

 +9        SET NOW=$$NOW^XLFDT

 +10       SET NOW=$TRANSLATE(NOW,".","")

 +11       SET UNIQN=$JOB_NOW

 +12       SET FILENAME="WVLETTER"_UNIQN_".DAT"

 +13       SET HFNAME=PATH_FILENAME

 +14       SET IOP="WV WORKSTATION;80"

 +15       SET %ZIS("HFSMODE")="W"

 +16       SET %ZIS("HFSNAME")=HFNAME

 +17       SET DIWF="^WV(790.404,WVPURP,1,"

 +18       SET DIWF(1)=790

 +19       SET BY="INTERNAL(#.01)="_WVDFN

 +20      ;get current complete address

           DO GADD^WVUTL9(WVDFN)

 +21      ;set complete address in File 790

           DO SADD^WVUTL9(WVDFN)

 +22      ;clean-up VADPT variables used

           DO KVAR^WVUTL9

 +23       DO EN2^DIWF

 +24       SET GBL="^TMP(""WVLETTER"",$J,1,0)"

 +25       SET GBL=$NAME(@GBL)

 +26       KILL ^TMP("WVLETTER",$JOB)

 +27       SET SUCCESS=$$FTG^%ZISH(PATH,FILENAME,GBL,3)

 +28      ;Look for a form feed, remove it and all subsequent lines.

 +29       SET FF=$CHAR(12)

 +30       IF $GET(VAR)["^"

               Begin DoDot:1

 +31               SET VAR=$NAME(@VAR)

 +32               SET VAR=$PIECE(VAR,")",1)

 +33               SET VAR=VAR_",IND,0)"

 +34               SET (DONE,IND)=0

 +35               FOR 

                       if DONE

                           QUIT 

                       SET IND=$ORDER(^TMP("WVLETTER",$JOB,IND))

                       if +IND=0

                           QUIT 

                       Begin DoDot:2

 +36                       IF ^TMP("WVLETTER",$JOB,IND,0)=FF

                               SET DONE=1

                               QUIT 

 +37                       SET @VAR=^TMP("WVLETTER",$JOB,IND,0)

                       End DoDot:2

               End DoDot:1

 +38      IF '$TEST

               Begin DoDot:1

 +39               SET (DONE,IND)=0

 +40               FOR 

                       if DONE

                           QUIT 

                       SET IND=$ORDER(^TMP("WVLETTER",$JOB,IND))

                       if +IND=0

                           QUIT 

                       Begin DoDot:2

 +41                       SET VAR(IND)=^TMP("WVLETTER",$JOB,IND,0)

 +42                       IF VAR(IND)=FF

                               SET DONE=1

                       End DoDot:2

               End DoDot:1

 +43       SET IND=0

           FOR 

               SET IND=$ORDER(^TMP("WVLETTER",$JOB,IND))

               if IND'>0

                   QUIT 

               Begin DoDot:1

 +44               SET RESULT(IND)=$GET(^TMP("WVLETTER",$JOB,IND,0))

               End DoDot:1

 +45       SET RESULT(0)=1_U_WVPURPTX_" letter"

 +46       KILL ^TMP("WVLETTER",$JOB)

 +47      ;Delete the host file.

 +48       SET FILESPEC(FILENAME)=""

 +49       SET SUCCESS=$$DEL^%ZISH(PATH,$NAME(FILESPEC))

 +50       QUIT 

 +51      ;

NEXTPROC(DFN,TYPE) ;

 +1        NEW NAME,NODE

 +2        IF TYPE="BR"

               SET NODE=$PIECE($GET(^WV(790,DFN,0)),U,18,19)

 +3        IF TYPE="CX"

               SET NODE=$PIECE($GET(^WV(790,DFN,0)),U,11,12)

 +4        IF +$PIECE(NODE,U)'>0

               QUIT ""

 +5        IF +$PIECE(NODE,U,2)'>0

               QUIT ""

 +6        IF TYPE="BR"

               SET NAME=$PIECE($GET(^WV(790.51,$PIECE(NODE,U),0)),U)

 +7        IF TYPE="CX"

               SET NAME=$PIECE($GET(^WV(790.5,$PIECE(NODE,U),0)),U)

 +8        IF NAME=""

               QUIT ""

 +9        QUIT NAME_U_$PIECE(NODE,U,2)

 +10      ;

VIEWDATA(RESULT,DATA,PAT,FINDVAL) ;

 +1       ;FINDINGS("WOMEN'S HEALTH",FILE,CNT)=SUBSCRIPT_U_VALUE_U_PROMPT TYPE IEN_U_PROMPT SUBSCRIPT

 +2        NEW CNT,PKG,FILE,NODE,SUB,VALUE

 +3        SET PKG="WOMEN'S HEALTH"

 +4        IF '$DATA(DATA(PKG,790.4))

               IF '$DATA(DATA(PKG,790.1))

                   QUIT 

 +5        IF $DATA(DATA(PKG,790.4))

               DO V7904(.RESULT,.DATA,PAT,FINDVAL)

 +6        IF $DATA(DATA(PKG,790.1))

               DO V7901(.RESULT,.DATA,PAT,FINDVAL)

 +7        QUIT 

 +8       ;

V7904(RESULT,DATA,PAT,FINDVAL) ;

 +1        NEW INC,NODE,PKG,SUB,SUB1,VALUE

 +2        SET PKG="WOMEN'S HEALTH"

 +3        SET INC=0

           FOR 

               SET INC=$ORDER(DATA(PKG,790.4,INC))

               if INC'>0

                   QUIT 

               Begin DoDot:1

 +4                SET NODE=$GET(DATA(PKG,790.4,INC))

 +5                SET SUB=$PIECE(NODE,U)

                   SET VALUE=$PIECE(NODE,U,2)

                   SET SUB1=$PIECE(NODE,U,4)

 +6                IF SUB=".04"

                       DO PRINT^WVRPCGF1(.RESULT,PAT,VALUE)

                       QUIT 

 +7       ;I SUB="No Notifications" D

 +8       ;.S RESULT(0)=0_U_"Procedure(s) with no documented notification"

 +9       ;.D FNDWDATA^PXRMRPCG(.RESULT,PAT,IEN,FINDVAL,VALUE)

               End DoDot:1

 +10       QUIT 

 +11      ;

V7901(RESULT,DATA,PAT,FINDVAL) ;

 +1        NEW CNT,DIR,DIAG,I,INC,NODE,PKG,SUB,SUB1,TCNT,TEXT,VALUE,X

 +2        SET PKG="WOMEN'S HEALTH"

 +3        SET INC=0

           FOR 

               SET INC=$ORDER(DATA(PKG,790.1,INC))

               if INC'>0

                   QUIT 

               Begin DoDot:1

 +4                SET NODE=$GET(DATA(PKG,790.1,INC))

 +5                SET SUB=$PIECE(NODE,U)

                   SET VALUE=$PIECE(NODE,U,2)

                   SET SUB1=$PIECE(NODE,U,4)

 +6                IF SUB="LAST THREE TRMTS"

                       Begin DoDot:2

 +7                        KILL ^TMP("PXRMRPCG REPORT",$JOB)

 +8                        SET DIR=1

 +9                        IF $$LAST3^WVHS("PXRMRPCG REPORT",PAT,3,DIR)=""

                               QUIT 

 +10                       SET RESULT(0)=1_U_"Last Three Breast Imaging Reports "_$SELECT(DIR=1:"(Most Recent to Oldest)",1:"(Oldest to Most Recent)")

 +11                       SET CNT=0

                           SET I=0

                           FOR 

                               SET I=$ORDER(^TMP("PXRMRPCG REPORT",$JOB,I))

                               if I'>0

                                   QUIT 

                               Begin DoDot:3

 +12                               SET CNT=CNT+1

                                   SET RESULT(CNT)=$GET(^TMP("PXRMRPCG REPORT",$JOB,I,0))

                               End DoDot:3

                       End DoDot:2

                       QUIT 

 +13               IF SUB=.01

                       Begin DoDot:2

 +14                       SET CNT=0

 +15      ;S RESULT(0)=1_U

 +16                       SET RESULT(0)=1_U_"Open Breast Imaging (Oldest to Most Recent)"

 +17                       FOR X=1:1:$LENGTH(FINDVAL,":")

                               Begin DoDot:3

 +18                               KILL TEXT

 +19      ;S TCNT=0

 +20                               DO GETTEST(+$PIECE(FINDVAL,":",X),.TEXT,.DIAG)

 +21                               IF X>1

                                       SET CNT=CNT+1