- 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 Feb 19, 2025@00:17:06 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