WVHS ;HCIOFO/FT - HEALTH SUMMARY INTERFACE ;12/18/2019
;;1.0;WOMEN'S HEALTH;**5,24**;Sep 30, 1998;Build 582
;
UD ; User Defined Health Summary. Called from [WV HS-USER DEFINED] option
; Select patient (DFN) and call HS supported call.
S WVPOP=0 N DFN
D PATIENT I WVPOP D KILL Q
N GMP,GMPATT,GMTSPHDR
I $T(MAIN^GMTSADOR)']"" D D KILL Q
.W !,"Sorry, the Health Summary package utility 'MAIN^GMTSADOR' does not exist.",!,"Please contact your IRM support person.",!
.Q
D MAIN^GMTSADOR
D KILL
Q
PATIENT ; Select a patient (can be male or female)
N DIC,DTOUT,DUOUT
S DIC="^DPT(",DIC(0)="AEMQZ"
D ^DIC
I Y<0!($D(DTOUT))!($D(DUOUT)) S WVPOP=1 Q
S DFN=+Y
Q
KILL ;
K WVDFN,WVEND,WVPOP,WVSTART,WVTYPE,X,Y
Q
;
;//AGP begin changes
LAST3(SUB,DFN,NGET,DIR) ;
;a DIR of 1 returns Newest to Oldest by date
;a DIR of -1 returns Oldest to Newest by date
;time is not taken into consideration
N ARRAY,CNT,DATE,I,INC,INVDATE,MAX,SORTARR,PROCIEN,TIEN,TERMLARR,TERMLIEN
N TNAME,WVIEN,WVDX,WVTERM,Y
K ^TMP(SUB,$J)
S MAX=$$BLDTARR^PXRMPRAD(.TERMLARR)
F X=1:1:MAX D
.S TNAME=TERMLARR(X)
.S TIEN=$O(^PXRMD(811.5,"B",TNAME,"")) Q:TIEN'>0
.S TERMLIEN(TIEN)=""
S DATE="",CNT=0,I=1 F S DATE=$O(^WV(790.1,"AC",DFN,DATE),-1) Q:DATE=""!(CNT>(NGET-1)) D
.S WVIEN=0 F S WVIEN=$O(^WV(790.1,"AC",DFN,DATE,WVIEN)) Q:WVIEN'>0!(CNT>(NGET-1)) D
..I $P($G(^WV(790.1,WVIEN,0)),U,15)="" Q
..S PROCIEN=$P($G(^WV(790.1,WVIEN,0)),U,4) Q:PROCIEN'>0
..S WVTERM=+$P($G(^WV(790.2,PROCIEN,3)),U) Q:WVTERM'>0
..I '$D(TERMLIEN(TIEN)) Q
..S CNT=CNT+1,ARRAY(CNT)=WVIEN
S INC="",CNT=0 F S INC=$O(ARRAY(INC),DIR) Q:INC="" D
.S WVIEN=ARRAY(INC)
.S PROCIEN=$P($G(^WV(790.1,WVIEN,0)),U,4) Q:PROCIEN'>0
.I $P($G(^WV(790.2,PROCIEN,0)),U,5)'="R" Q
.K ^TMP("WV RPT",$J)
.D EN^WVALERTR(WVIEN,.WVDX)
.S CNT=CNT+1
.I CNT>1 S I=I+1,^TMP(SUB,$J,I,0)="",I=I+1,^TMP(SUB,$J,I,0)="__________________________________________________________",I=I+1,^TMP(SUB,$J,I,0)=""
.S Y=0 F S Y=$O(^TMP("WV RPT",$J,Y)) Q:Y'>0 S I=I+1,^TMP(SUB,$J,I,0)=$G(^TMP("WV RPT",$J,Y,0))
I CNT=0 S ^TMP(SUB,$J,1,0)="No Test Found"
I CNT>0 S ^TMP(SUB,$J,1,0)="Total tests returned: "_CNT
Q "~@"_$NA(^TMP(SUB,$J))
;//AGP end changes
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVHS 2251 printed Oct 16, 2024@18:47:28 Page 2
WVHS ;HCIOFO/FT - HEALTH SUMMARY INTERFACE ;12/18/2019
+1 ;;1.0;WOMEN'S HEALTH;**5,24**;Sep 30, 1998;Build 582
+2 ;
UD ; User Defined Health Summary. Called from [WV HS-USER DEFINED] option
+1 ; Select patient (DFN) and call HS supported call.
+2 SET WVPOP=0
NEW DFN
+3 DO PATIENT
IF WVPOP
DO KILL
QUIT
+4 NEW GMP,GMPATT,GMTSPHDR
+5 IF $TEXT(MAIN^GMTSADOR)']""
Begin DoDot:1
+6 WRITE !,"Sorry, the Health Summary package utility 'MAIN^GMTSADOR' does not exist.",!,"Please contact your IRM support person.",!
+7 QUIT
End DoDot:1
DO KILL
QUIT
+8 DO MAIN^GMTSADOR
+9 DO KILL
+10 QUIT
PATIENT ; Select a patient (can be male or female)
+1 NEW DIC,DTOUT,DUOUT
+2 SET DIC="^DPT("
SET DIC(0)="AEMQZ"
+3 DO ^DIC
+4 IF Y<0!($DATA(DTOUT))!($DATA(DUOUT))
SET WVPOP=1
QUIT
+5 SET DFN=+Y
+6 QUIT
KILL ;
+1 KILL WVDFN,WVEND,WVPOP,WVSTART,WVTYPE,X,Y
+2 QUIT
+3 ;
+4 ;//AGP begin changes
LAST3(SUB,DFN,NGET,DIR) ;
+1 ;a DIR of 1 returns Newest to Oldest by date
+2 ;a DIR of -1 returns Oldest to Newest by date
+3 ;time is not taken into consideration
+4 NEW ARRAY,CNT,DATE,I,INC,INVDATE,MAX,SORTARR,PROCIEN,TIEN,TERMLARR,TERMLIEN
+5 NEW TNAME,WVIEN,WVDX,WVTERM,Y
+6 KILL ^TMP(SUB,$JOB)
+7 SET MAX=$$BLDTARR^PXRMPRAD(.TERMLARR)
+8 FOR X=1:1:MAX
Begin DoDot:1
+9 SET TNAME=TERMLARR(X)
+10 SET TIEN=$ORDER(^PXRMD(811.5,"B",TNAME,""))
if TIEN'>0
QUIT
+11 SET TERMLIEN(TIEN)=""
End DoDot:1
+12 SET DATE=""
SET CNT=0
SET I=1
FOR
SET DATE=$ORDER(^WV(790.1,"AC",DFN,DATE),-1)
if DATE=""!(CNT>(NGET-1))
QUIT
Begin DoDot:1
+13 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.1,"AC",DFN,DATE,WVIEN))
if WVIEN'>0!(CNT>(NGET-1))
QUIT
Begin DoDot:2
+14 IF $PIECE($GET(^WV(790.1,WVIEN,0)),U,15)=""
QUIT
+15 SET PROCIEN=$PIECE($GET(^WV(790.1,WVIEN,0)),U,4)
if PROCIEN'>0
QUIT
+16 SET WVTERM=+$PIECE($GET(^WV(790.2,PROCIEN,3)),U)
if WVTERM'>0
QUIT
+17 IF '$DATA(TERMLIEN(TIEN))
QUIT
+18 SET CNT=CNT+1
SET ARRAY(CNT)=WVIEN
End DoDot:2
End DoDot:1
+19 SET INC=""
SET CNT=0
FOR
SET INC=$ORDER(ARRAY(INC),DIR)
if INC=""
QUIT
Begin DoDot:1
+20 SET WVIEN=ARRAY(INC)
+21 SET PROCIEN=$PIECE($GET(^WV(790.1,WVIEN,0)),U,4)
if PROCIEN'>0
QUIT
+22 IF $PIECE($GET(^WV(790.2,PROCIEN,0)),U,5)'="R"
QUIT
+23 KILL ^TMP("WV RPT",$JOB)
+24 DO EN^WVALERTR(WVIEN,.WVDX)
+25 SET CNT=CNT+1
+26 IF CNT>1
SET I=I+1
SET ^TMP(SUB,$JOB,I,0)=""
SET I=I+1
SET ^TMP(SUB,$JOB,I,0)="__________________________________________________________"
SET I=I+1
SET ^TMP(SUB,$JOB,I,0)=""
+27 SET Y=0
FOR
SET Y=$ORDER(^TMP("WV RPT",$JOB,Y))
if Y'>0
QUIT
SET I=I+1
SET ^TMP(SUB,$JOB,I,0)=$GET(^TMP("WV RPT",$JOB,Y,0))
End DoDot:1
+28 IF CNT=0
SET ^TMP(SUB,$JOB,1,0)="No Test Found"
+29 IF CNT>0
SET ^TMP(SUB,$JOB,1,0)="Total tests returned: "_CNT
+30 QUIT "~@"_$NAME(^TMP(SUB,$JOB))
+31 ;//AGP end changes
