DGPREP2 ;ALB/SCK - Pre-Registration Cont. ; 12/31/96
;;5.3;Registration;**109**;Aug 13, 1993
Q
;
EN ; -- main entry point for the DGPRE HIST protocol
I '$D(^DGS(41.43,"C",PTIFN)) Q
D EN^VALM("DGPRE HIST")
Q
;
HDR ; -- header code
S VALMHDR(1)="Calling History for "_$P(^DPT(PTIFN,0),U)
Q
;
INIT ; -- init variables and list array
; Variables
; DGPDT - Formatted date from Call Log, #41.43
; DGPDD - Status entries from the DD for #41.43
; DGPNR - No. of entries, index for LM IDX global
; DGPN1 - Local Var for $O
; DGPDATA - 0 node from Call Log file, #41.43
;
N DGPN1,DGPNR,DGPNDX,DGPDD,DGPDT,DGPDATA
;
K ^TMP($J)
K ^TMP("DGPPR2",$J)
S DGPN1=0 F S DGPN1=$O(^DGS(41.43,"C",PTIFN,DGPN1)) Q:'DGPN1 D
. S ^TMP($J,$P(^DGS(41.43,DGPN1,0),U))=DGPN1
S DGPNR=1
S DGPDD=$P(^DD(41.43,3,0),U,3)
S DGPN1=1 F Q:$P(DGPDD,";",DGPN1)']"" S DGPT($P($P(DGPDD,";",DGPN1),":"))=$P($P(DGPDD,";",DGPN1),":",2),DGPN1=DGPN1+1
S DGPN1=9999999.999999 F S DGPN1=$O(^TMP($J,DGPN1),-1) Q:'DGPN1 D
. S DGPDATA=^DGS(41.43,^TMP($J,DGPN1),0)
. S DGPDT=$$FMTE^XLFDT($P(DGPDATA,U),1)
. S X=$$SETFLD^VALM1(DGPNR,"","INDEX")
. S X=$$SETFLD^VALM1(DGPDT,X,"DATE/TIME")
. I $P(DGPDATA,U,3)]"" S X=$$SETFLD^VALM1($P(^VA(200,$P(DGPDATA,U,3),0),U),X,"CALLED BY")
. I $P(DGPDATA,U,4)]"" S X=$$SETFLD^VALM1(DGPT($P(DGPDATA,U,4)),X,"STATUS")
. S ^TMP("DGPPR2",$J,DGPNR,0)=X
. S ^TMP("DGPPR2",$J,"IEN",DGPNR,^TMP($J,DGPN1))=""
. S ^TMP("DGPPR2",$J,"IDX",DGPNR,DGPNR)=""
. S DGPNR=DGPNR+1
S VALMCNT=DGPNR-1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("DGPPR2",$J)
K DGPDATA
D FULL^VALM1
D CLEAN^VALM10
Q
;
EXPND ; -- expand on the selected call log entry
; Variables
; DGPIEN - IEN of selected patient
; DGPCM - Comments from the Call Log, displayed 1 line at a time
; DGPN1-3 - Loacal Var's for $O
;
N DGPN1,DGPIEN,DGPN2,DGPN3,DGPCM,VALMI,VALMAT,VALMY
;
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S") S VALMI=0
I '$D(VALMY) S VALMBCK="R" Q
;
S DGPN1="",DGPN2=$O(VALMY(DGPN1))
S DGPIEN="",DGPIEN=$O(^TMP("DGPPR2",$J,"IEN",DGPN2,DGPIEN))
;
S DGPN3=""
F S DGPN3=$O(^DGS(41.43,DGPIEN,1,DGPN3)) Q:DGPN3']"" D
. S DGPCM=$G(^DGS(41.43,DGPIEN,1,DGPN3,0))
. I DGPCM]"" W !,DGPCM
D PAUSE^VALM1
Q
;
INQ ; Entry point for patient Inquiry
;
N DGPRFLG
S DGPRFLG=1
D ^DGRPD
Q
;
PTINQ ; Patient inquiry protocol
N DGPN1,DGPN2,DFN,DGPRFLG
;
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S") S VALMI=0
;
I '$D(VALMY) S VALMBCK="R" Q
S DGPN1="",DGPN2=$O(VALMY(DGPN1))
S DFN="",DFN=$O(^TMP("DGPRERG",$J,"DFN",DGPN2,DFN))
;
; *** Force check for Sensitive patient
S DIC=2,DIC(0)="ENQ",X=DFN D ^DIC K DIC
Q:Y<0
;
S DGPRFLG=1
D EN^DGRPD
D PAUSE^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPREP2 2843 printed Dec 13, 2024@02:51:05 Page 2
DGPREP2 ;ALB/SCK - Pre-Registration Cont. ; 12/31/96
+1 ;;5.3;Registration;**109**;Aug 13, 1993
+2 QUIT
+3 ;
EN ; -- main entry point for the DGPRE HIST protocol
+1 IF '$DATA(^DGS(41.43,"C",PTIFN))
QUIT
+2 DO EN^VALM("DGPRE HIST")
+3 QUIT
+4 ;
HDR ; -- header code
+1 SET VALMHDR(1)="Calling History for "_$PIECE(^DPT(PTIFN,0),U)
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 ; Variables
+2 ; DGPDT - Formatted date from Call Log, #41.43
+3 ; DGPDD - Status entries from the DD for #41.43
+4 ; DGPNR - No. of entries, index for LM IDX global
+5 ; DGPN1 - Local Var for $O
+6 ; DGPDATA - 0 node from Call Log file, #41.43
+7 ;
+8 NEW DGPN1,DGPNR,DGPNDX,DGPDD,DGPDT,DGPDATA
+9 ;
+10 KILL ^TMP($JOB)
+11 KILL ^TMP("DGPPR2",$JOB)
+12 SET DGPN1=0
FOR
SET DGPN1=$ORDER(^DGS(41.43,"C",PTIFN,DGPN1))
if 'DGPN1
QUIT
Begin DoDot:1
+13 SET ^TMP($JOB,$PIECE(^DGS(41.43,DGPN1,0),U))=DGPN1
End DoDot:1
+14 SET DGPNR=1
+15 SET DGPDD=$PIECE(^DD(41.43,3,0),U,3)
+16 SET DGPN1=1
FOR
if $PIECE(DGPDD,";",DGPN1)']""
QUIT
SET DGPT($PIECE($PIECE(DGPDD,";",DGPN1),":"))=$PIECE($PIECE(DGPDD,";",DGPN1),":",2)
SET DGPN1=DGPN1+1
+17 SET DGPN1=9999999.999999
FOR
SET DGPN1=$ORDER(^TMP($JOB,DGPN1),-1)
if 'DGPN1
QUIT
Begin DoDot:1
+18 SET DGPDATA=^DGS(41.43,^TMP($JOB,DGPN1),0)
+19 SET DGPDT=$$FMTE^XLFDT($PIECE(DGPDATA,U),1)
+20 SET X=$$SETFLD^VALM1(DGPNR,"","INDEX")
+21 SET X=$$SETFLD^VALM1(DGPDT,X,"DATE/TIME")
+22 IF $PIECE(DGPDATA,U,3)]""
SET X=$$SETFLD^VALM1($PIECE(^VA(200,$PIECE(DGPDATA,U,3),0),U),X,"CALLED BY")
+23 IF $PIECE(DGPDATA,U,4)]""
SET X=$$SETFLD^VALM1(DGPT($PIECE(DGPDATA,U,4)),X,"STATUS")
+24 SET ^TMP("DGPPR2",$JOB,DGPNR,0)=X
+25 SET ^TMP("DGPPR2",$JOB,"IEN",DGPNR,^TMP($JOB,DGPN1))=""
+26 SET ^TMP("DGPPR2",$JOB,"IDX",DGPNR,DGPNR)=""
+27 SET DGPNR=DGPNR+1
End DoDot:1
+28 SET VALMCNT=DGPNR-1
+29 QUIT
+30 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("DGPPR2",$JOB)
+2 KILL DGPDATA
+3 DO FULL^VALM1
+4 DO CLEAN^VALM10
+5 QUIT
+6 ;
EXPND ; -- expand on the selected call log entry
+1 ; Variables
+2 ; DGPIEN - IEN of selected patient
+3 ; DGPCM - Comments from the Call Log, displayed 1 line at a time
+4 ; DGPN1-3 - Loacal Var's for $O
+5 ;
+6 NEW DGPN1,DGPIEN,DGPN2,DGPN3,DGPCM,VALMI,VALMAT,VALMY
+7 ;
+8 DO FULL^VALM1
+9 DO EN^VALM2(XQORNOD(0),"S")
SET VALMI=0
+10 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT
+11 ;
+12 SET DGPN1=""
SET DGPN2=$ORDER(VALMY(DGPN1))
+13 SET DGPIEN=""
SET DGPIEN=$ORDER(^TMP("DGPPR2",$JOB,"IEN",DGPN2,DGPIEN))
+14 ;
+15 SET DGPN3=""
+16 FOR
SET DGPN3=$ORDER(^DGS(41.43,DGPIEN,1,DGPN3))
if DGPN3']""
QUIT
Begin DoDot:1
+17 SET DGPCM=$GET(^DGS(41.43,DGPIEN,1,DGPN3,0))
+18 IF DGPCM]""
WRITE !,DGPCM
End DoDot:1
+19 DO PAUSE^VALM1
+20 QUIT
+21 ;
INQ ; Entry point for patient Inquiry
+1 ;
+2 NEW DGPRFLG
+3 SET DGPRFLG=1
+4 DO ^DGRPD
+5 QUIT
+6 ;
PTINQ ; Patient inquiry protocol
+1 NEW DGPN1,DGPN2,DFN,DGPRFLG
+2 ;
+3 DO FULL^VALM1
+4 DO EN^VALM2(XQORNOD(0),"S")
SET VALMI=0
+5 ;
+6 IF '$DATA(VALMY)
SET VALMBCK="R"
QUIT
+7 SET DGPN1=""
SET DGPN2=$ORDER(VALMY(DGPN1))
+8 SET DFN=""
SET DFN=$ORDER(^TMP("DGPRERG",$JOB,"DFN",DGPN2,DFN))
+9 ;
+10 ; *** Force check for Sensitive patient
+11 SET DIC=2
SET DIC(0)="ENQ"
SET X=DFN
DO ^DIC
KILL DIC
+12 if Y<0
QUIT
+13 ;
+14 SET DGPRFLG=1
+15 DO EN^DGRPD
+16 DO PAUSE^VALM1
+17 QUIT
