DGPAR ;ALB/MRL - ADT PARAMETER ENTRY/EDIT ; 07 MAR 87
;;5.3;Registration;**51,86,93,109,214,343,903**;Aug 13, 1993;Build 82
I '$D(^DG(43,1,0))#2 S DA=1,^DG(43,1,0)=1,DIK="^DG(43," D IX1^DIK
WR D DT^DICRW S U="^",DGHEAD="PIMS VERSION "_$S('$D(^DG(43,1,"VERSION")):"'UNKNOWN'",^("VERSION")[".":^("VERSION"),1:^("VERSION")_".0")_" PARAMETER ENTRY/EDIT",IOP="HOME" D ^%ZIS K IOP
W @IOF,!?20,DGHEAD,! S X="",$P(X,"=",79)="" W X F I=0,"GL","BT","SCLR","DGPRE","REC","PH" S DGNOD(I)=$S($D(^DG(43,1,I)):^(I),1:"")
S DGMULT=+$P(DGNOD("GL"),"^",2),DGPTFP=+$P(DGNOD(0),"^",31) W !,"[1] Medical Center Name : ",$S($D(^DG(40.8,+$P(DGNOD("GL"),"^",3),0)):$P(^(0),"^",1),1:"NONE SPECIFIED"),?59,"Affiliated: ",$S(+$P(DGNOD("GL"),"^",4):"YES",1:"NO")
W !?4,"Multidivisional : ",$S(+$P(DGNOD("GL"),"^",2):"YES",1:"NO")
W !?4,"Nursing Home Wards : ",$S(+$P(DGNOD(0),"^",20):"YES",1:"NO")
W ?52,"Domiciliary Wards: ",$S(+$P(DGNOD(0),"^",21):"YES",1:"NO")
W !?4,"System Timeout Sec. : ",+$P(DGNOD(0),"^",5),?51,"Print PTF Messages: ",$S($P(DGNOD(0),"^",31):"YES",1:"NO")
;W !?4,"G&L Earliest Date : " S Y=$P(DGNOD("GL"),"^",1) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NONE SPECIFIED")
W !?4,"Default PTF Printer : ",$S($P(DGNOD(0),"^",19)]"":$P(DGNOD(0),"^",19),1:"NONE SPECIFIED"),?55,"High Intensity: ",$S($P(DGNOD(0),"^",36):"ON",1:"OFF")
W !?4,"Consistency Checker : ",$S($P(DGNOD(0),"^",37):"ON",1:"OFF"),?50,"Abbreviated Inquiry: ",$S($P(DGNOD(0),"^",38):"YES",1:"NO")
W !?4,"Auto PTF Messages : ",$S($P(DGNOD(0),"^",40)!($P(DGNOD(0),"^",40)']""):"YES",1:"NO"),?51,"Show Status Screen: ",$S($P(DGNOD(0),"^",34):"YES",1:"NO")
S DGX=46 W !!,"[2] Days to Update Medicaid",?31,": ",$S('$P(^DG(43,1,0),U,46):365,1:+$P(^(0),U,46))
W ?45,"Maintain G&L Corrections: " S DGX=29,DGX1="DAY" D DAY W !?4,"Disposition late",?31,": " S DGX=7,DGX1="HOUR" D DAY
S DGX=8 W ?51,"Supplemental 10/10: " D DO
S DGX=27 W !?4,"Ask HINQ at Registration",?31,": " D DO
S DGX=17 W ?46,"DRUG PROFILE with 10/10: " D DO
I $P(^DG(43,1,0),U,17) D
.S DGX=44 W !?4,"CHOICE OF DRUG PROFILE?",?31,": " D DO
.W ?49,"Default Drug Profile: "
.S X=$P(^DG(43,1,0),U,45) W $S(X="A":"ACTION",1:"INFO.")
S X="GMTSDVR" X ^%ZOSF("TEST") I $T I $T(ENXQ^GMTSDVR)]"" S DGHSFLG=1
W !?4,"HEALTH SUMMARY with 10/10 : " W:'$G(DGHSFLG) "N/A"
I $G(DGHSFLG) D
.N DIC,X,Y
.S DGX=42 D DO
.W ?47,"Default Health Summary: "
.S X=$P($G(^DG(43,1,0)),U,43),DIC=142,DIC(0)="NX"
.D ^DIC
.W $S(Y<0:"NONE",1:$E($P(Y,U,2),1,8))
K DGHSFLG
EMB S DGX=28 W !?4,"Ask EMBOSS at Registration : " D DO
S DGX=30 W ?50,"Use Nearest Printer: " D DO
W !?4,"Reg. Template (LOCAL)",?31,": ",$S('$P(DGNOD(0),"^",35):"NONE SPECIFIED",'$D(^DIE(+$P(DGNOD(0),"^",35),0)):"NONE SPECIFIED",1:$P(^DIE(+$P(DGNOD(0),"^",35),0),"^",1))
W ?53,"Use Temp Address: ",$S($P(DGNOD("BT"),"^",3):"YES",1:"NO")
W !?4,"Default Code Sheet Printer : ",$S($P(DGNOD(0),"^",25)]"":$P(DGNOD(0),"^",25),1:"NONE SPECIFIED"),?51,"Ask Device in Reg.: ",$S($P(DGNOD(0),"^",39):"YES",1:"NO")
S DGX=33 W !?4,"Days to Maintain Sens. Data: ",$S('$P(^DG(43,1,0),"^",33):"Forever",1:+$P(^(0),"^",33))
S DGX=47 W ?49,"Print Encounter Form",?31,": " D DO
W !?4,"Default EF Printer",?31,": ",$S($P(DGNOD(0),"^",48)]"":$P(DGNOD(0),"^",48),1:"NONE SPECIFIED")
REC ;Write PATIENT (#2) file record access parameter
W !?4,"Restrict PATIENT access : ",$S($P($G(DGNOD("REC")),U)=1:"YES",1:"NO")
W !?4,"Purple Heart Sort",?31,": ",$S($P($G(DGNOD("PH")),U)="A":"Ascending",1:"Descending")
PREREG ; write pre-registration parameters
W !!?4,"[Pre-Registration]"
W !?4,"Sort Method",?31,": ",$P($G(DGNOD("DGPRE")),U),?46,"Background Job Function: ",$P($G(DGNOD("DGPRE")),U,3)
W !?4,"Days Between Calls",?31,": ",$P($G(DGNOD("DGPRE")),U,2),?41,"Days to Maintain Log Entries: ",$P($G(DGNOD("DGPRE")),U,4)
W !?4,"Days to Pull Appointments",?31,": ",$P($G(DGNOD("DGPRE")),U,5),?54,"Run for Weekend: ",$S($P($G(DGNOD("DGPRE")),U,6):"YES",1:"NO")
;
I +$P($G(^DG(43,1,"DGPREC",0)),U,3)>0 D
. W !!?4,"Excluded Clinics:"
. N NDX,LNDX
. S LNDX=1
. S NDX="" F S NDX=$O(^DG(43,1,"DGPREC","B",NDX)) Q:'NDX D
.. I LNDX=1 W !?4,$E($P(^SC(NDX,0),U),1,20) S LNDX=2 Q
.. I LNDX=2 W ?30,$E($P(^SC(NDX,0),U),1,20) S LNDX=3 Q
.. I LNDX=3 W ?55,$E($P(^SC(NDX,0),U),1,20) S LNDX=1 Q
;
I +$P($G(^DG(43,1,"DGPREE",0)),U,3)>0 D
. W !!?4,"Excluded Eligibilities:"
. N NDX,LNDX
. S LNDX=1
. S NDX="" F S NDX=$O(^DG(43,1,"DGPREE","B",NDX)) Q:'NDX D
.. I LNDX=1 W !?4,$E($P(^DIC(8,NDX,0),U),1,20) S LNDX=2 Q
.. I LNDX=2 W ?30,$E($P(^DIC(8,NDX,0),U),1,20) S LNDX=3 Q
.. I LNDX=3 W ?55,$E($P(^DIC(8,NDX,0),U),1,20) S LNDX=1 Q
W !?4,"Enable My HealtheVet Prompts",?32,": ",$S(+$P($G(DGNOD("DGPRE")),U,7)=1:"YES",1:"NO")
;
DIV ; write division parameters
W !!,"[3]" I DGMULT W ?4,"Divisions: " F I=0:0 S I=$O(^DG(40.8,I)) Q:'I S X=$P(^(I,0),"^",1)_$S($P(^(0),"^",2)]"":" ("_$P(^(0),"^",2)_"), ",1:"") W:$L(X)>(65-$X) !?15 W X
I 'DGMULT S DGD=+$P(DGNOD("GL"),"^",3),DGDV=$S($D(^DG(40.8,DGD,"DEV")):^("DEV"),1:""),DGZE=$S($D(^(0)):^(0),1:"") D DEV^DGPAR1
G ^DGPAR1
DAY S DGD=+$P(DGNOD(0),"^",DGX) I DGX=29,'DGD W "FOREVER" Q
W DGD,"-",DGX1,$S(DGD=1:"",1:"S") Q
DO I DGX'=8 W $S('$P(DGNOD(0),"^",DGX):"NO",1:"YES") Q
W $S('$P(DGNOD(0),"^",DGX):"YES",1:"NO") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPAR 5331 printed Apr 09, 2024@21:42:03 Page 2
DGPAR ;ALB/MRL - ADT PARAMETER ENTRY/EDIT ; 07 MAR 87
+1 ;;5.3;Registration;**51,86,93,109,214,343,903**;Aug 13, 1993;Build 82
+2 IF '$DATA(^DG(43,1,0))#2
SET DA=1
SET ^DG(43,1,0)=1
SET DIK="^DG(43,"
DO IX1^DIK
WR DO DT^DICRW
SET U="^"
SET DGHEAD="PIMS VERSION "_$SELECT('$DATA(^DG(43,1,"VERSION")):"'UNKNOWN'",^("VERSION")[".":^("VERSION"),1:^("VERSION")_".0")_" PARAMETER ENTRY/EDIT"
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+1 WRITE @IOF,!?20,DGHEAD,!
SET X=""
SET $PIECE(X,"=",79)=""
WRITE X
FOR I=0,"GL","BT","SCLR","DGPRE","REC","PH"
SET DGNOD(I)=$SELECT($DATA(^DG(43,1,I)):^(I),1:"")
+2 SET DGMULT=+$PIECE(DGNOD("GL"),"^",2)
SET DGPTFP=+$PIECE(DGNOD(0),"^",31)
WRITE !,"[1] Medical Center Name : ",$SELECT($DATA(^DG(40.8,+$PIECE(DGNOD("GL"),"^",3),0)):$PIECE(^(0),"^",1),1:"NONE SPECIFIED"),?59,"Affiliated: ",$SELECT(+$PIECE(DGNOD("GL"),"^",4):"YES",1:"NO")
+3 WRITE !?4,"Multidivisional : ",$SELECT(+$PIECE(DGNOD("GL"),"^",2):"YES",1:"NO")
+4 WRITE !?4,"Nursing Home Wards : ",$SELECT(+$PIECE(DGNOD(0),"^",20):"YES",1:"NO")
+5 WRITE ?52,"Domiciliary Wards: ",$SELECT(+$PIECE(DGNOD(0),"^",21):"YES",1:"NO")
+6 WRITE !?4,"System Timeout Sec. : ",+$PIECE(DGNOD(0),"^",5),?51,"Print PTF Messages: ",$SELECT($PIECE(DGNOD(0),"^",31):"YES",1:"NO")
+7 ;W !?4,"G&L Earliest Date : " S Y=$P(DGNOD("GL"),"^",1) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NONE SPECIFIED")
+8 WRITE !?4,"Default PTF Printer : ",$SELECT($PIECE(DGNOD(0),"^",19)]"":$PIECE(DGNOD(0),"^",19),1:"NONE SPECIFIED"),?55,"High Intensity: ",$SELECT($PIECE(DGNOD(0),"^",36):"ON",1:"OFF")
+9 WRITE !?4,"Consistency Checker : ",$SELECT($PIECE(DGNOD(0),"^",37):"ON",1:"OFF"),?50,"Abbreviated Inquiry: ",$SELECT($PIECE(DGNOD(0),"^",38):"YES",1:"NO")
+10 WRITE !?4,"Auto PTF Messages : ",$SELECT($PIECE(DGNOD(0),"^",40)!($PIECE(DGNOD(0),"^",40)']""):"YES",1:"NO"),?51,"Show Status Screen: ",$SELECT($PIECE(DGNOD(0),"^",34):"YES",1:"NO")
+11 SET DGX=46
WRITE !!,"[2] Days to Update Medicaid",?31,": ",$SELECT('$PIECE(^DG(43,1,0),U,46):365,1:+$PIECE(^(0),U,46))
+12 WRITE ?45,"Maintain G&L Corrections: "
SET DGX=29
SET DGX1="DAY"
DO DAY
WRITE !?4,"Disposition late",?31,": "
SET DGX=7
SET DGX1="HOUR"
DO DAY
+13 SET DGX=8
WRITE ?51,"Supplemental 10/10: "
DO DO
+14 SET DGX=27
WRITE !?4,"Ask HINQ at Registration",?31,": "
DO DO
+15 SET DGX=17
WRITE ?46,"DRUG PROFILE with 10/10: "
DO DO
+16 IF $PIECE(^DG(43,1,0),U,17)
Begin DoDot:1
+17 SET DGX=44
WRITE !?4,"CHOICE OF DRUG PROFILE?",?31,": "
DO DO
+18 WRITE ?49,"Default Drug Profile: "
+19 SET X=$PIECE(^DG(43,1,0),U,45)
WRITE $SELECT(X="A":"ACTION",1:"INFO.")
End DoDot:1
+20 SET X="GMTSDVR"
XECUTE ^%ZOSF("TEST")
IF $TEST
IF $TEXT(ENXQ^GMTSDVR)]""
SET DGHSFLG=1
+21 WRITE !?4,"HEALTH SUMMARY with 10/10 : "
if '$GET(DGHSFLG)
WRITE "N/A"
+22 IF $GET(DGHSFLG)
Begin DoDot:1
+23 NEW DIC,X,Y
+24 SET DGX=42
DO DO
+25 WRITE ?47,"Default Health Summary: "
+26 SET X=$PIECE($GET(^DG(43,1,0)),U,43)
SET DIC=142
SET DIC(0)="NX"
+27 DO ^DIC
+28 WRITE $SELECT(Y<0:"NONE",1:$EXTRACT($PIECE(Y,U,2),1,8))
End DoDot:1
+29 KILL DGHSFLG
EMB SET DGX=28
WRITE !?4,"Ask EMBOSS at Registration : "
DO DO
+1 SET DGX=30
WRITE ?50,"Use Nearest Printer: "
DO DO
+2 WRITE !?4,"Reg. Template (LOCAL)",?31,": ",$SELECT('$PIECE(DGNOD(0),"^",35):"NONE SPECIFIED",'$DATA(^DIE(+$PIECE(DGNOD(0),"^",35),0)):"NONE SPECIFIED",1:$PIECE(^DIE(+$PIECE(DGNOD(0),"^",35),0),"^",1))
+3 WRITE ?53,"Use Temp Address: ",$SELECT($PIECE(DGNOD("BT"),"^",3):"YES",1:"NO")
+4 WRITE !?4,"Default Code Sheet Printer : ",$SELECT($PIECE(DGNOD(0),"^",25)]"":$PIECE(DGNOD(0),"^",25),1:"NONE SPECIFIED"),?51,"Ask Device in Reg.: ",$SELECT($PIECE(DGNOD(0),"^",39):"YES",1:"NO")
+5 SET DGX=33
WRITE !?4,"Days to Maintain Sens. Data: ",$SELECT('$PIECE(^DG(43,1,0),"^",33):"Forever",1:+$PIECE(^(0),"^",33))
+6 SET DGX=47
WRITE ?49,"Print Encounter Form",?31,": "
DO DO
+7 WRITE !?4,"Default EF Printer",?31,": ",$SELECT($PIECE(DGNOD(0),"^",48)]"":$PIECE(DGNOD(0),"^",48),1:"NONE SPECIFIED")
REC ;Write PATIENT (#2) file record access parameter
+1 WRITE !?4,"Restrict PATIENT access : ",$SELECT($PIECE($GET(DGNOD("REC")),U)=1:"YES",1:"NO")
+2 WRITE !?4,"Purple Heart Sort",?31,": ",$SELECT($PIECE($GET(DGNOD("PH")),U)="A":"Ascending",1:"Descending")
PREREG ; write pre-registration parameters
+1 WRITE !!?4,"[Pre-Registration]"
+2 WRITE !?4,"Sort Method",?31,": ",$PIECE($GET(DGNOD("DGPRE")),U),?46,"Background Job Function: ",$PIECE($GET(DGNOD("DGPRE")),U,3)
+3 WRITE !?4,"Days Between Calls",?31,": ",$PIECE($GET(DGNOD("DGPRE")),U,2),?41,"Days to Maintain Log Entries: ",$PIECE($GET(DGNOD("DGPRE")),U,4)
+4 WRITE !?4,"Days to Pull Appointments",?31,": ",$PIECE($GET(DGNOD("DGPRE")),U,5),?54,"Run for Weekend: ",$SELECT($PIECE($GET(DGNOD("DGPRE")),U,6):"YES",1:"NO")
+5 ;
+6 IF +$PIECE($GET(^DG(43,1,"DGPREC",0)),U,3)>0
Begin DoDot:1
+7 WRITE !!?4,"Excluded Clinics:"
+8 NEW NDX,LNDX
+9 SET LNDX=1
+10 SET NDX=""
FOR
SET NDX=$ORDER(^DG(43,1,"DGPREC","B",NDX))
if 'NDX
QUIT
Begin DoDot:2
+11 IF LNDX=1
WRITE !?4,$EXTRACT($PIECE(^SC(NDX,0),U),1,20)
SET LNDX=2
QUIT
+12 IF LNDX=2
WRITE ?30,$EXTRACT($PIECE(^SC(NDX,0),U),1,20)
SET LNDX=3
QUIT
+13 IF LNDX=3
WRITE ?55,$EXTRACT($PIECE(^SC(NDX,0),U),1,20)
SET LNDX=1
QUIT
End DoDot:2
End DoDot:1
+14 ;
+15 IF +$PIECE($GET(^DG(43,1,"DGPREE",0)),U,3)>0
Begin DoDot:1
+16 WRITE !!?4,"Excluded Eligibilities:"
+17 NEW NDX,LNDX
+18 SET LNDX=1
+19 SET NDX=""
FOR
SET NDX=$ORDER(^DG(43,1,"DGPREE","B",NDX))
if 'NDX
QUIT
Begin DoDot:2
+20 IF LNDX=1
WRITE !?4,$EXTRACT($PIECE(^DIC(8,NDX,0),U),1,20)
SET LNDX=2
QUIT
+21 IF LNDX=2
WRITE ?30,$EXTRACT($PIECE(^DIC(8,NDX,0),U),1,20)
SET LNDX=3
QUIT
+22 IF LNDX=3
WRITE ?55,$EXTRACT($PIECE(^DIC(8,NDX,0),U),1,20)
SET LNDX=1
QUIT
End DoDot:2
End DoDot:1
+23 WRITE !?4,"Enable My HealtheVet Prompts",?32,": ",$SELECT(+$PIECE($GET(DGNOD("DGPRE")),U,7)=1:"YES",1:"NO")
+24 ;
DIV ; write division parameters
+1 WRITE !!,"[3]"
IF DGMULT
WRITE ?4,"Divisions: "
FOR I=0:0
SET I=$ORDER(^DG(40.8,I))
if 'I
QUIT
SET X=$PIECE(^(I,0),"^",1)_$SELECT($PIECE(^(0),"^",2)]"":" ("_$PIECE(^(0),"^",2)_"), ",1:"")
if $LENGTH(X)>(65-$X)
WRITE !?15
WRITE X
+2 IF 'DGMULT
SET DGD=+$PIECE(DGNOD("GL"),"^",3)
SET DGDV=$SELECT($DATA(^DG(40.8,DGD,"DEV")):^("DEV"),1:"")
SET DGZE=$SELECT($DATA(^(0)):^(0),1:"")
DO DEV^DGPAR1
+3 GOTO ^DGPAR1
DAY SET DGD=+$PIECE(DGNOD(0),"^",DGX)
IF DGX=29
IF 'DGD
WRITE "FOREVER"
QUIT
+1 WRITE DGD,"-",DGX1,$SELECT(DGD=1:"",1:"S")
QUIT
DO IF DGX'=8
WRITE $SELECT('$PIECE(DGNOD(0),"^",DGX):"NO",1:"YES")
QUIT
+1 WRITE $SELECT('$PIECE(DGNOD(0),"^",DGX):"YES",1:"NO")
QUIT
