- DG1010PA ;ALB/REW - 1010 PRINT--INQUIRY PATIENT -ADDITIONL ; 28-MAY-93
- ;;5.3;Registration;**18,28,86,108,113,570,624**;Aug 13, 1993
- ;
- NOREG(DFN) ; DOES PROMPTS FOR 10/10 PRINT W/O REGISTRATION
- ;INPUT: DFN
- ;OUTPUT: VARIABLES NEEDED FOR DIFFERENT PRINTOUTS
- ; DGMTYPT - MT=1 Copay=2 None=0
- ; DGOPT - WHICH REPORTS TO PRINT
- ; DGPMDA - Admissions Report Info
- ; PRF - FLAG FOR RX PROFILE
- ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
- ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
- ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
- ; PSTYPE - TYPE OF DRUG PROFILE
- ; GMTSTYP - TYPE OF HEALTH SUMMARY
- ; EASMTIEN - Means Test IEN used for EZ/EZR
- ;
- ;
- N DG1,I,X,Y,FORM
- S FREE=+$P(^DG(43,1,0),U,8),DGOPT=""
- S PRF=0 G QTNOREG:'$D(^DG(43,1,0)) ;NEED MAS PARAMETERS TO CONTINUE
- I $$PROMPRN("THIRD") G:DG1<0 QTNOREG S DGOPT=DGOPT_3
- S FORM=$$SEL1010^DG1010P()
- S EASMTIEN=$$MTPRMPT^DG1010P(DFN,$G(DGMTI))
- I FORM<0 S DG1=-1 G QTNOREG
- I FORM="EZ" S DGOPT=DGOPT_0
- I FORM="EZR" S DGOPT=DGOPT_1
- I $$PROMPRN("HS") G:DG1<0 QTNOREG S DGOPT=DGOPT_8
- I $$PROMPRN("PRO") G:DG1<0 QTNOREG S DGOPT=DGOPT_5,PRF=1
- QTNOREG S:$G(DG1)<0 DGOPT=""
- Q
- PROMPRN(DGX) ; PROMPTS FOR PRINT
- ; RETURNS DGX [1=YES;0=NO;-1=DIRUT CONDITIONS]
- ; OUTPUT:DG1 VALUE
- S DG1=0
- I $$FAILCOND(DGX) S DG1=$S($D(DG1):DG1,1:2) G QTPROMP ;DEFAULT=NO
- F D Q:$G(DG1)
- .S DG1=$$ASK(DGX)
- .S:DG1=1 DG1=$$AFTERASK(DGX)
- QTPROMP Q $S(DG1=2:0,(DG1=1):1,1:DG1)
- ASK(DGX) ; PROMPTS FOR PRINT
- ;
- ; RETURNS DGX [2=NO,1=YES;0=?,-1=DIRUT CONDITIONS]
- W !,"PRINT "
- W $S(DGX="THIRD":"ERROR",(DGX="HS"):"HEALTH SUMMARY",(DGX="PRO"):"DRUG PROFILE",(DGX="EF"):"ENCOUNTER FORMS",1:"ERROR")
- S %=1 D YN^DICN I '% W !,"ENTER 'Y'ES TO PRINT A ",DGX,". OTHERWISE ENTER 'N'O."
- Q $G(%)
- FAILCOND(DGX) ;CHECKS IF PROMPT SHOULD BE ASKED
- ;
- ; DGI: 2=NO;1=YES;-1=DIRUT
- ;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK
- ;
- N DGFAIL
- S DGFAIL=0
- I DGX=1010 G QTFAIL
- I DGX="THIRD" F D Q:$G(%) G QTFAIL
- .N DGNOQ,DGDEF
- .D ADM
- .S DGFAIL=1
- .I DGPMDA>0!$D(^DGS(41.1,"B",DFN)) D
- ..S (DGNOQ,DGDEF)=1 D ASK^DGBLRV
- ..S DG1=%
- I DGX="HS" S DGFAIL=1 D G QTFAIL
- .S X="GMTSDVR" X ^%ZOSF("TEST") I $T D
- ..S:$T(ENXQ^GMTSDVR)]""&($P(^DG(43,1,0),U,42)) DGFAIL=0
- I DGX="PRO" S DGFAIL=1 D G QTFAIL
- .S X="PSOSD1" X ^%ZOSF("TEST") I '$T Q
- .I '$P(^DG(43,1,0),U,17) Q
- .S DGFAIL=0
- I DGX="EF" D G QTFAIL
- .I $P(^DG(43,1,0),U,47)'=1 S DGFAIL=1 Q
- QTFAIL Q DGFAIL
- AFTERASK(DGX) ;ACTIONS AFTER REPONSE OF YES TO PRINT
- ;NOTE: Reports removed from DG REGISTRATION 10/10 REPRINT option are
- ; remaining to support any outside integrations.
- ;
- ; RETURNS DGGO[2=DON'T PRINT,1=PRINT,-1=ABORT]
- ; SETS PRINT-SETUP VARIABLES
- ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
- ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
- ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
- ; PSTYPE = DRUG PROFILE TYPE
- ; GMTSTYP = POINTER TO HEALTH SUMMARY TYPE
- ;
- N DGGO,DIR,X,Y
- S DGGO=1
- I DGX="HS" D ;HEALTH SUMMARY
- .S X=$P($G(^DG(43,1,0)),U,43),DIC=142,DIC(0)="NX"
- .D ^DIC K DIC
- .S:+Y DIR("B")=$P(Y,U,2)
- .S DIR(0)="PO^142:QAMEZ"
- .D ^DIR
- .I Y'>0 W !,*7,"No Type Selected. HS will not print" S DGGO=2 K DIR,DIRUT,DUOUT Q
- .S GMTSTYP=+Y
- I DGX="PRO" D ;DRUG PROFILE
- .S DGGO=0
- .N DGDEF
- .S DGDEF=$P(^DG(43,1,0),U,45)
- .I $P(^DG(43,1,0),U,44) D
- ..S:DGDEF]"" DIR("B")=$S(DGDEF="A":"ACTION",(DGDEF="I"):"INFORMATIONAL",1:"")
- ..S DIR(0)="SM^A:ACTION;I:INFORMATIONAL"
- ..S DIR("A")="Select type of Drug Profile"
- ..D ^DIR
- ..S DGDEF=Y
- .I '$D(DIRUT) D
- ..S (PSOPAR,PSTYPE)=$S(DGDEF="A":1,(DGDEF="I"):0,1:0),(DGGO,PSONOPG)=1
- ..S PSOINST=+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U)
- Q DGGO
- ADM K DGPMDA I $D(^DGPM("ATID1",DFN)) F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I!(I>(DFN1+.9999)) S DGPMDA=$O(^(I,0))
- S DGPMDA=$S($D(DGPMDA):DGPMDA,1:0)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG1010PA 4003 printed Feb 19, 2025@00:01:10 Page 2
- DG1010PA ;ALB/REW - 1010 PRINT--INQUIRY PATIENT -ADDITIONL ; 28-MAY-93
- +1 ;;5.3;Registration;**18,28,86,108,113,570,624**;Aug 13, 1993
- +2 ;
- NOREG(DFN) ; DOES PROMPTS FOR 10/10 PRINT W/O REGISTRATION
- +1 ;INPUT: DFN
- +2 ;OUTPUT: VARIABLES NEEDED FOR DIFFERENT PRINTOUTS
- +3 ; DGMTYPT - MT=1 Copay=2 None=0
- +4 ; DGOPT - WHICH REPORTS TO PRINT
- +5 ; DGPMDA - Admissions Report Info
- +6 ; PRF - FLAG FOR RX PROFILE
- +7 ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
- +8 ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
- +9 ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
- +10 ; PSTYPE - TYPE OF DRUG PROFILE
- +11 ; GMTSTYP - TYPE OF HEALTH SUMMARY
- +12 ; EASMTIEN - Means Test IEN used for EZ/EZR
- +13 ;
- +14 ;
- +15 NEW DG1,I,X,Y,FORM
- +16 SET FREE=+$PIECE(^DG(43,1,0),U,8)
- SET DGOPT=""
- +17 ;NEED MAS PARAMETERS TO CONTINUE
- SET PRF=0
- if '$DATA(^DG(43,1,0))
- GOTO QTNOREG
- +18 IF $$PROMPRN("THIRD")
- if DG1<0
- GOTO QTNOREG
- SET DGOPT=DGOPT_3
- +19 SET FORM=$$SEL1010^DG1010P()
- +20 SET EASMTIEN=$$MTPRMPT^DG1010P(DFN,$GET(DGMTI))
- +21 IF FORM<0
- SET DG1=-1
- GOTO QTNOREG
- +22 IF FORM="EZ"
- SET DGOPT=DGOPT_0
- +23 IF FORM="EZR"
- SET DGOPT=DGOPT_1
- +24 IF $$PROMPRN("HS")
- if DG1<0
- GOTO QTNOREG
- SET DGOPT=DGOPT_8
- +25 IF $$PROMPRN("PRO")
- if DG1<0
- GOTO QTNOREG
- SET DGOPT=DGOPT_5
- SET PRF=1
- QTNOREG if $GET(DG1)<0
- SET DGOPT=""
- +1 QUIT
- PROMPRN(DGX) ; PROMPTS FOR PRINT
- +1 ; RETURNS DGX [1=YES;0=NO;-1=DIRUT CONDITIONS]
- +2 ; OUTPUT:DG1 VALUE
- +3 SET DG1=0
- +4 ;DEFAULT=NO
- IF $$FAILCOND(DGX)
- SET DG1=$SELECT($DATA(DG1):DG1,1:2)
- GOTO QTPROMP
- +5 FOR
- Begin DoDot:1
- +6 SET DG1=$$ASK(DGX)
- +7 if DG1=1
- SET DG1=$$AFTERASK(DGX)
- End DoDot:1
- if $GET(DG1)
- QUIT
- QTPROMP QUIT $SELECT(DG1=2:0,(DG1=1):1,1:DG1)
- ASK(DGX) ; PROMPTS FOR PRINT
- +1 ;
- +2 ; RETURNS DGX [2=NO,1=YES;0=?,-1=DIRUT CONDITIONS]
- +3 WRITE !,"PRINT "
- +4 WRITE $SELECT(DGX="THIRD":"ERROR",(DGX="HS"):"HEALTH SUMMARY",(DGX="PRO"):"DRUG PROFILE",(DGX="EF"):"ENCOUNTER FORMS",1:"ERROR")
- +5 SET %=1
- DO YN^DICN
- IF '%
- WRITE !,"ENTER 'Y'ES TO PRINT A ",DGX,". OTHERWISE ENTER 'N'O."
- +6 QUIT $GET(%)
- FAILCOND(DGX) ;CHECKS IF PROMPT SHOULD BE ASKED
- +1 ;
- +2 ; DGI: 2=NO;1=YES;-1=DIRUT
- +3 ;RETURNS 1=DON'T ASK AND SKIP TO NEXT;0=ASK
- +4 ;
- +5 NEW DGFAIL
- +6 SET DGFAIL=0
- +7 IF DGX=1010
- GOTO QTFAIL
- +8 IF DGX="THIRD"
- FOR
- Begin DoDot:1
- +9 NEW DGNOQ,DGDEF
- +10 DO ADM
- +11 SET DGFAIL=1
- +12 IF DGPMDA>0!$DATA(^DGS(41.1,"B",DFN))
- Begin DoDot:2
- +13 SET (DGNOQ,DGDEF)=1
- DO ASK^DGBLRV
- +14 SET DG1=%
- End DoDot:2
- End DoDot:1
- if $GET(%)
- QUIT
- GOTO QTFAIL
- +15 IF DGX="HS"
- SET DGFAIL=1
- Begin DoDot:1
- +16 SET X="GMTSDVR"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- Begin DoDot:2
- +17 if $TEXT(ENXQ^GMTSDVR)]""&($PIECE(^DG(43,1,0),U,42))
- SET DGFAIL=0
- End DoDot:2
- End DoDot:1
- GOTO QTFAIL
- +18 IF DGX="PRO"
- SET DGFAIL=1
- Begin DoDot:1
- +19 SET X="PSOSD1"
- XECUTE ^%ZOSF("TEST")
- IF '$TEST
- QUIT
- +20 IF '$PIECE(^DG(43,1,0),U,17)
- QUIT
- +21 SET DGFAIL=0
- End DoDot:1
- GOTO QTFAIL
- +22 IF DGX="EF"
- Begin DoDot:1
- +23 IF $PIECE(^DG(43,1,0),U,47)'=1
- SET DGFAIL=1
- QUIT
- End DoDot:1
- GOTO QTFAIL
- QTFAIL QUIT DGFAIL
- AFTERASK(DGX) ;ACTIONS AFTER REPONSE OF YES TO PRINT
- +1 ;NOTE: Reports removed from DG REGISTRATION 10/10 REPRINT option are
- +2 ; remaining to support any outside integrations.
- +3 ;
- +4 ; RETURNS DGGO[2=DON'T PRINT,1=PRINT,-1=ABORT]
- +5 ; SETS PRINT-SETUP VARIABLES
- +6 ; PSOINST - STATION NUMBER (INSTITUTION FILE) FOR ACTION PROFILE PRINT
- +7 ; PSONOPG - USED FOR PRINTING ACTION PROFILE (SET TO 1)
- +8 ; PSOPAR - PRINT BARCODES FOR ACTION PROFILE (SET TO 1)
- +9 ; PSTYPE = DRUG PROFILE TYPE
- +10 ; GMTSTYP = POINTER TO HEALTH SUMMARY TYPE
- +11 ;
- +12 NEW DGGO,DIR,X,Y
- +13 SET DGGO=1
- +14 ;HEALTH SUMMARY
- IF DGX="HS"
- Begin DoDot:1
- +15 SET X=$PIECE($GET(^DG(43,1,0)),U,43)
- SET DIC=142
- SET DIC(0)="NX"
- +16 DO ^DIC
- KILL DIC
- +17 if +Y
- SET DIR("B")=$PIECE(Y,U,2)
- +18 SET DIR(0)="PO^142:QAMEZ"
- +19 DO ^DIR
- +20 IF Y'>0
- WRITE !,*7,"No Type Selected. HS will not print"
- SET DGGO=2
- KILL DIR,DIRUT,DUOUT
- QUIT
- +21 SET GMTSTYP=+Y
- End DoDot:1
- +22 ;DRUG PROFILE
- IF DGX="PRO"
- Begin DoDot:1
- +23 SET DGGO=0
- +24 NEW DGDEF
- +25 SET DGDEF=$PIECE(^DG(43,1,0),U,45)
- +26 IF $PIECE(^DG(43,1,0),U,44)
- Begin DoDot:2
- +27 if DGDEF]""
- SET DIR("B")=$SELECT(DGDEF="A":"ACTION",(DGDEF="I"):"INFORMATIONAL",1:"")
- +28 SET DIR(0)="SM^A:ACTION;I:INFORMATIONAL"
- +29 SET DIR("A")="Select type of Drug Profile"
- +30 DO ^DIR
- +31 SET DGDEF=Y
- End DoDot:2
- +32 IF '$DATA(DIRUT)
- Begin DoDot:2
- +33 SET (PSOPAR,PSTYPE)=$SELECT(DGDEF="A":1,(DGDEF="I"):0,1:0)
- SET (DGGO,PSONOPG)=1
- +34 SET PSOINST=+$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),99)),U)
- End DoDot:2
- End DoDot:1
- +35 QUIT DGGO
- ADM KILL DGPMDA
- IF $DATA(^DGPM("ATID1",DFN))
- FOR I=0:0
- SET I=$ORDER(^DGPM("ATID1",DFN,I))
- if 'I!(I>(DFN1+.9999))
- QUIT
- SET DGPMDA=$ORDER(^(I,0))
- +1 SET DGPMDA=$SELECT($DATA(DGPMDA):DGPMDA,1:0)
- +2 QUIT